! Page 1 ! ! COPYRIGHT © 1983, 1984, 1985 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS ! ALL RIGHTS RESERVED ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! ! !++ ! FACILITY: ! Text Processing Utility (VAXTPU) ! ! ABSTRACT: ! This is the VAXTPU source program for the EDT emulator interface ! ! ENVIRONMENT: ! VAX/VMS ! !Authors: Sharon Burlingame, Steve Long, Terrell Mitchell ! ! CREATION DATE: 1-June-1983 ! ! MODIFIED BY: ! !-- ! EDTSECINI.TPU ! ! Table of Contents as of 23-Nov-1985 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! edt$init_variables 2 initialize global variables ! edt$append 4 kp9 (append) ! edt$backspace 5 backspace key ! edt$command 6 gold kp7 (TPU command) ! edt$change_case 7 gold kp1 (change case) ! edt$cut 8 kp6 ( cut selected text) ! edt$on_search_range 8 Select and substitute support routine ! edt$select_range 8 cut support routine ! edt$decrease_tab 9 ctrl d (decrease tab level) ! edt$define_key 9 ctrl k (define key) ! edt$delete_char 10 keypad comma (delete chr) ! edt$delete_beg_line 11 ctrl u ( delete to beg. of line) ! edt$delete_end_word 12 keypad minus (delete word) ! edt$delete_line 12 pf4 (delete line) ! edt$delete_to_eol 12 gold kp2 ( delete to end of line) ! edt$end_of_line 13 kp2 (move to end of line) ! edt$fill 14 gold kp8 (fill) ! edt$preserve_blanks 14 support routine for fill ! edt$skip_leading_spaces 15 support routine for fill ! edt$find_whiteline 15 support routine for fill ! edt$skip_lines 15 support routine for fill ! edt$gold_number 16 gold 0..9 (repeat counts) ! edt$help 17 gold pf2 (help on topic) ! edt$increase_tab 17 ctrl e (increase tab level) ! edt$keypad_help 18 pf2 (keypad help) ! edt$create_keypad_diagram 18 support routine for keypad help ! edt$get_keypad_diagram 18 support routine for keypad help ! edt$Line_mode 19 ctrl z (line mode) ! edt$next_Token 20 support routine for line mode ! edt$find_buffer 21 support routine for line mode ! edt$range_specification 21 support routine for line mode ! edt$buffer 22 support routine for line mode(= buffer cmd) ! edt$show 23 support routine for line mode(show cmd) ! edt$set 24 support routine for line mode(set cmd) ! edt$write 25 support routine for line mode(write cmd) ! edt$include 26 support routine for line mode(include cmd) ! edt$quit 27 support routine for line mode(quit cmd) ! edt$exit 27 support routine for line mode(exit cmd) ! edt$line_mode_substitute 28 support routine for line mode(subs cmd) ! edt$find_sub_delimiter 28 support routine for subs cmd ! edt$single_search_replace 29 support routine for subs cmd ! edt$global_search_replace 29 support routine for subs cmd ! edt$move_word 30 kp2 (move word) ! edt$move_word_r 30 support routine for move word (reverse) ! edt$move_word_f 30 support routine for move word (forward) ! edt$del_beg_word 30 support routine for delete word (forward) ! edt$beg_word 30 support routine for move word ! edt$end_word 30 support routine for delete word ! edt$next_prev_line 31 kp0 (next line) ! edt$page 32 kp7 (move to next page) ! edt$paste 32 gold kp6 (paste selected text) ! edt$replace 32 gold kp9 (replace) ! edt$reset 33 gold kepypad dot(reset) ! edt$rubout 33 rubout key (erase prev chr) ! edt$search 34 gold pf3 (search) ! edt$search_next 34 pf3 (search next) ! edt$section 35 kp8 (section) ! edt$select 35 keypad dot (select) ! edt$substitute 35 gold enter (substitute) ! edt$cancel_subs 35 support routine for substitute ! edt$tab 36 tab key ! edt$tab_adjust 36 ctrl t (adjust tabs) ! edt$undelete_char 37 gold comma (undelete character) ! edt$undelete_line 37 gold pf4 (undelete line) ! edt$undelete_word 37 gold keypad minus(undelete word) ! edt$on_end_of_line 38 support routine for undelete ! edt$wrap_word 39 space key (wrap word) ! EDT$define_keys 40 define all keys ! tpu$local_init 45 local initialization ! tpu$init_procedure 45 initialization procedure ! Page 2 !+ ! Procedures with names beginning with edt$ are edt commands. These ! procedures are subject to change. In the future, Digital may supply ! new procedures beginning with edt$, remove some of the edt$ procedures, ! or change existing edt$ procedures. The same is true for global variables ! with names beginning with edt$. User-written procedures should not ! begin with edt$. !- procedure edt$init_variables ! initialize global variables ! ! Initialize some variables ! ! ! Create the null variable ! edt$x_empty := ''; edt$x_version : =0; ! ! Each command must be eleven characters long, with the first being a space TRUE:=1; FALSE:=0; edt$x_search_begin := 1; edt$x_terminators := ' =%'; edt$x_subs_term := '/'; edt$x_word := " "; edt$x_prefixes := ' %'; edt$x_wrap_position := 0; edt$x_tab_size := 4; edt$x_tab_goal := 8; edt$x_tabs_set := 1; edt$x_keypad_window := 0; edt$x_delete_crlf:=0; edt$x_appended_line := 0; edt$x_section_distance:=16; edt$x_beginning_of_select := 0; edt$x_search_string := edt$x_empty; edt$x_search_case := no_exact; edt$x_deleted_char := edt$x_empty; edt$x_deleted_word := edt$x_empty; edt$x_deleted_line := edt$x_empty; edt$x_search_range:=0; edt$x_select_range := 0; edt$x_repeat_count := 1; edt$x_video:=reverse; edt$x_info_stats_video := none; edt$x_control_chars := " "; ! Page 3 edt$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(edt$x_word) | edt$x_empty) ) ) | !no leading spaces,on a word delimiter,move one past it (any(edt$x_word)) | !no leading spaces,on a real word,go one beyond it (scan(edt$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(' ') | edt$x_empty) ; endprocedure ! Page 4 !+ ! EDT APPEND !- procedure edt$append !kp9 (append) LOCAL temp_pos ; edt$select_range; if edt$x_select_range <> 0 then temp_pos := mark(none); position(end_of(paste_buffer)); move_horizontal(-1); move_text(edt$x_select_range); edt$x_select_range:=0; position(temp_pos); else message("No Select Active"); edt$x_repeat_count := 1; endif; endprocedure ! Page 5 !+ ! EDT Backspace !- procedure edt$backspace !backspace key LOCAL temp_length ; temp_length := current_offset; if temp_length = 0 then move_vertical(-1) ; move_horizontal(- current_offset); ! Make sure we are at 0 else move_horizontal(-temp_length) endif; endprocedure ! Page 6 !+ ! EDT gold 7 emulation(command line processing) !- procedure edt$command !gold kp7 (TPU command) LOCAL line_read, x; !+ ! Trap compilation failures !- ON_ERROR IF error = tpu$_compilefail THEN message ('Unrecognized command'); RETURN ENDIF; ENDON_ERROR ! ! input: prompt string ! outputs: function returns true if string read is NOT compiled ! !+ ! Get the command(s) to execute !- line_read:=read_line('TPU Command: '); ! get line from user if line_read <> edt$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 edt$help ('HELP'); return endif; !+ ! compile them !- x:=compile(line_read); else return endif; !+ ! execute !- if x <> 0 then execute(x); endif; endprocedure ! Page 7 !+ !EDT CHANGECASE !- procedure edt$change_case !gold kp1 (change case) LOCAL character ; !check for active select edt$select_range; if edt$x_select_range <> 0 then change_case(edt$x_select_range,invert); edt$x_select_range:=0; return; endif; !change case of current character if current_character <> edt$x_empty then character :=current_character; change_case(character,invert); erase_character(1); copy_text(character); if current_direction <> forward then move_horizontal(-2); endif; return endif; endprocedure ! Page 8 !+ ! EDT 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 edt$cut !kp6 ( cut selected text) LOCAL temp_position ; edt$select_range; if edt$x_select_range <> 0 then temp_position := mark(none); erase(paste_buffer); position(paste_buffer); split_line; move_vertical(-1); move_text(edt$x_select_range); position(temp_position); edt$x_select_range:=0; else message("No Select Active"); edt$x_repeat_count := 1; endif; endprocedure !+ ! Procedure to determine if we are sitting on the search range. !- procedure edt$on_search_range ! Select and substitute support routine local v_on_search; if (edt$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(edt$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(edt$x_search_range) then v_on_search := 1; else v_on_search := 0; endif; move_horizontal(1); endif; return v_on_search; endprocedure; !+ ! Procedure to create the select range !- procedure edt$select_range ! cut support routine if (edt$x_beginning_of_select <> 0) then edt$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 (edt$x_select_range = 0) then position (end_of(current_buffer)); edt$x_select_range := create_range (mark(none), mark(none), none); position (edt$x_beginning_of_select); endif; edt$x_beginning_of_select := 0; else ! Check for being on search string and repeat count <= 1 if (edt$x_search_range <> 0) then if (edt$on_search_range = 1) AND (edt$x_repeat_count <= 1) then edt$x_select_range := edt$x_search_range; else edt$x_select_range := 0; endif else edt$x_select_range := 0; endif; endif; endprocedure ! Page 9 ! ! EDT ctrl d ! procedure edt$decrease_tab !ctrl d (decrease tab level) edt$x_tab_goal := edt$x_tab_goal - edt$x_tab_size; if (edt$x_tab_goal < 0) then edt$x_tab_goal := 0 endif; endprocedure; !+ ! EDT ctrl k (Define Key) !- procedure edt$define_key !ctrl k (define key) LOCAL def, input_key; def := read_line('Definition: '); input_key := read_line('Press key to define.',1); input_key := last_key; define_key(def,input_key); endprocedure ! Page 10 ! ! EDT DELETE CHARACTER ! procedure edt$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 edt$x_deleted_char := erase_character(1); if (edt$x_deleted_char = edt$x_empty) then edt$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 11 ! ! EDT Delete to the beginning of the line ! ! procedure edt$delete_beg_line !ctrl u ( delete to beg. of line) edt$x_deleted_line := erase_character(- current_offset); if edt$x_deleted_line = edt$x_empty ! then delete previous line then if mark(none) <> beginning_of(current_buffer) then move_vertical(-1); edt$delete_line; ! delete the entire previous line endif; endif; edt$x_delete_crlf := 0; edt$x_appended_line := 0; endprocedure ! Page 12 ! ! Delete to end of word ! procedure edt$delete_end_word ! keypad minus (delete word) LOCAL temp_length ; temp_length := edt$end_word; if temp_length = 0 ! then we are on eol then edt$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 edt$x_deleted_word := erase_character(- temp_length) ! delete the word endif; endprocedure ! ! EDT delete line ! ! procedure edt$delete_line !pf4 (delete line) if current_offset = 0 then edt$x_deleted_line := erase_line else edt$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; edt$x_delete_crlf := 1; edt$x_appended_line := 0; endprocedure ! ! ! EDT Delete to the end of the line ! ! procedure edt$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); edt$x_deleted_line := erase_line; edt$x_appended_line := 1; edt$x_delete_crlf := 0; else edt$x_appended_line := 0; edt$x_delete_crlf := 1; endif; move_horizontal (-1); else edt$x_deleted_line := erase_character(length(current_line)); edt$x_appended_line := 0; edt$x_delete_crlf := 0; endif; endprocedure ! Page 13 !+ ! Move the next End of Line !- procedure edt$end_of_line !kp2 (move to end of line) if current_direction = forward then if mark(none) <> end_of (current_buffer) then if edt$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 ! end of EOL ! Page 14 !+ ! EDT FILL !- procedure edt$fill !gold kp8 (fill) edt$select_range; if edt$x_select_range <> 0 then ! patterns for matching multiple blank lines edt$x_whit_pat:=line_begin &(line_end|(span(' ') &line_end))&line_begin; if (edt$x_wrap_position = 0) then edt$preserve_blanks(0) else edt$preserve_blanks(1) endif; edt$x_select_range:=0; else message("No Select Active"); edt$x_repeat_count := 1; endif; endprocedure procedure edt$preserve_blanks(flag) ! support routine for fill LOCAL original_position, b_mark, e_mark, sub_range, temp_range, all_done, temp_pattern; on_error all_done:=1; ! cause exit endon_error; original_position:=mark(none); b_mark:=beginning_of(edt$x_select_range); ! skip leading spaces on first line only edt$skip_leading_spaces(b_mark); position(original_position); loop ! skip leading blank lines of a paragraph edt$skip_lines(b_mark); all_done:=edt$find_whiteline(b_mark,e_mark); ! start looking here exitif all_done; ! now only fill the range created between the blank lines sub_range:=create_range(b_mark,e_mark,none); ! go to line following the range position(e_mark); move_horizontal(1); move_vertical(1); ! pick up search at end of current_range b_mark:=mark(none); ! do the fill operation if flag then fill(sub_range,edt$x_word,1,edt$x_wrap_position); else fill(sub_range,edt$x_word,1,get_info(current_window,'width')); endif; exitif all_done; endloop; position(original_position); endprocedure ! Page 15 ! procedure edt$skip_leading_spaces(b_mark) ! support routine for fill local temp_pattern,temp_range; on_error return endon_error; position(b_mark); temp_pattern:=anchor&span(' '); temp_range:=search(temp_pattern,forward); position(end_of(temp_range)); move_horizontal(1); b_mark:=mark(none); endprocedure procedure edt$find_whiteline(beg_mark,end_mark) ! support routine for fill local bline; on_error position(beg_mark); end_mark:= end_of(edt$x_select_range); return 0; endon_error; position(beg_mark); if beg_mark >= end_of(edt$x_select_range) then return 1 ! all done endif; bline:=search(edt$x_whit_pat,forward); ! get the beginning and end points right if beginning_of(bline) > end_of(edt$x_select_range) then end_mark:= end_of(edt$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 procedure edt$skip_lines(where) ! support routine for fill !skip multiple blank lines ! once that one blank line is found on_error where:=mark(none); return; endon_error; position(where); loop if current_line <> edt$x_empty then exitif; endif; move_vertical(1); move_horizontal(-current_offset); endloop; where:=mark(none); return endprocedure ! Page 16 !+ ! Procedures for emulating the EDT style GOLD digit commands. !- procedure edt$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 = edt$x_empty then term_char := last_key; exe_flag := 1; exitif ; endif; ! See if it is a control character if (index(edt$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 edt$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(edt$x_repeat_count)) else ! ! 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 = edt$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); edt$x_repeat_count := edt$x_repeat_count - 1; exitif edt$x_repeat_count < 1; endloop; endif; endif else loop copy_text(term_char); edt$x_repeat_count := edt$x_repeat_count - 1; exitif edt$x_repeat_count < 1; endloop; endif; edt$x_repeat_count := 1; endprocedure; ! Page 17 !+ ! TPU help !- procedure edt$help (topic_param) ! gold pf2 (help on topic) if get_info(help_buffer,"type") = UNSPECIFIED then ! Get the help buffer help_buffer := create_buffer("HELP"); set(eob_text,help_buffer,edt$x_empty); set(no_write,help_buffer); set(system,help_buffer); endif; set(status_line,info_window,edt$x_info_stats_video,'Press CTRL-Z to leave prompts THEN CTRL-F to resume editing'); set(width,info_window,get_info(screen,'width')); map(info_window,help_buffer); if (topic_param = edt$x_empty) then help_text('tpuhelp', read_line('Topic: '), on, help_buffer); else help_text('tpuhelp', topic_param, on, help_buffer); endif; endprocedure ! procedure edt$increase_tab !ctrl e (increase tab level) edt$x_tab_goal := edt$x_tab_goal + edt$x_tab_size; endprocedure ! Page 18 !+ ! EDT Help !- procedure edt$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 (edt$x_keypad_window = 0) then edt$create_keypad_diagram; else edt$get_keypad_diagram; endif; ! Turn off the timer temporarily timer_string := get_info (system, 'timed_message'); if timer_string <> 0 then SET (TIMER, OFF); 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, edt$x_keypad_window, reverse, diagram_prompt); map(edt$x_keypad_window,edt$x_keypad_buffer); update(edt$x_keypad_window); help_key := READ_KEY; !temp_string := READ_LINE (diagram_prompt, 0); loop ! help_key := last_key; comment_string := lookup_key (help_key, COMMENT); EXITIF comment_string = "return"; if comment_string = "keypad_diagram" then edt$get_keypad_diagram; set (status_line, edt$x_keypad_window, reverse, diagram_prompt); current_prompt := diagram_prompt; else set (text, edt$x_keypad_window, blank_tabs); set (status_line, edt$x_keypad_window, reverse, text_prompt); current_prompt := text_prompt; if comment_string = edt$x_empty then comment_string := "no" endif; help_text ('tpuhelp', 'edt_emulator keypad ' + comment_string, OFF, edt$x_keypad_buffer); position (beginning_of (edt$x_keypad_buffer)); erase_line; erase_line; erase_line; erase_line; position (beginning_of (edt$x_keypad_buffer)); endif; update(edt$x_keypad_window); help_key := READ_KEY; ! temp_string := READ_LINE (current_prompt, 0); endloop; unmap (edt$x_keypad_window); ! Restore the timer if timer_string <> 0 then SET (TIMER, ON); endif; endprocedure !+ ! Create the buffer and window for the keypad diagram. !- procedure edt$create_keypad_diagram !support routine for keypad help edt$x_keypad_window := create_window(1,22,off); edt$x_keypad_buffer := create_buffer('keypad diagram'); set(no_write,edt$x_keypad_buffer); set(eob_text,edt$x_keypad_buffer, edt$x_empty); edt$get_keypad_diagram; endprocedure !+ ! Get the keypad diagram into the editor !- procedure edt$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 (edt$x_keypad_buffer, "type") = UNSPECIFIED) then return; endif; ! Pad the prompt to make it the same size as the text_prompt set(text,edt$x_keypad_window,no_translate); erase (edt$x_keypad_buffer); help_text('tpuhelp','keypad_dia edt_vt100',off,edt$x_keypad_buffer); ! Go clean up the text in the buffer position(beginning_of(edt$x_keypad_buffer)); ! Get rid of the topic lines erase_line; erase_line; erase_line; erase_line; erase_line; ! Now delete the 5 spaces at the beginning of each line loop exitif mark(none) = end_of(edt$x_keypad_buffer); erase_character(5); move_vertical(1); endloop; erase_line; position(beginning_of(edt$x_keypad_buffer)); endprocedure ! Page 19 !+ ! This is bound to the ^Z key. It will read a line and parse it, looking ! for the first thing to be one of the line mode commands it can ! interpret. !- procedure edt$Line_mode !ctrl z (line mode) LOCAL command_name , command_status , term_char , original_line, org_line_length, new_line_length, command_index ; if edt$x_version = 0 then !+ ! initialize some global variables needed by the line mode parser !- edt$x_range_length := 7; edt$x_make_buf_var := 'new'; edt$x_version := 'EDT Keypad Emulator Version V1.2-000'; edt$x_commands := ' XXXXXXXXXX CHANGE EXIT QUIT INCLUDE WRITE = SET SHOW HELP ' + ' SUBSTITUTE'; edt$x_command_length := 11; edt$x_ranges := ' SELECT WHOLE REST BEFORE = '; edt$x_sets := ' SCREEN WRAP CURSOR TAB SEARCH'; edt$x_set_length := 7; edt$x_shows := ' BUFFER SEARCH SCREEN VERSION CURSOR WRAP '; edt$x_show_length := 8; edt$x_searches := ' GENERAL EXACT BEGIN END '; edt$x_searches_length := 8; endif; !+ ! Keep looping until we see something that will cause us to exit. ! Right now this is only the Change command !- loop edt$x_line := read_line('*'); ! Save the original line in case this is a substitute command original_line := edt$x_line; org_line_length := LENGTH (original_line); ! If they don't type something, set up the continue command change_case(edt$x_line,upper); ! What command is it? command_name := edt$next_token('/',term_char); if (command_name = edt$x_empty) then command_name := 'XXXX'; endif; command_index := index(edt$x_commands,(' '+ command_name)); command_index := ((command_index + edt$x_command_length)-1) / edt$x_command_length; CASE command_index FROM 0 TO 11 [0]: message(command_name + ' not supported') ; [2]: exitif; [3]: if (term_char = '/') then command_status := edt$exit(1); else command_status := edt$exit(0); endif; [4]: if (term_char = '/') then command_status := edt$quit(1); else command_status := edt$quit(0); endif; [5]: command_status := edt$include [6]: command_status := edt$write [7]: command_status := edt$buffer [8]: command_status := edt$set [9]: command_status := edt$show [10]: if (edt$x_line = edt$x_empty) then edt$help ('EDT_EM HELP'); else edt$help ('EDT_EM LINE_MODE ' + edt$x_line); endif; exitif; [11]: ! Get the original line back because the case is important new_line_length := LENGTH (edt$x_line); edt$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 (edt$x_line, 1, 1); edt$x_line := substr (edt$x_line, 2, length (edt$x_line)-1); endloop; if (term_char <> edt$x_subs_term) then message (term_char + ' is an invalid delimiter for SUBSTITUTE'); command_status := 0; else command_status := edt$line_mode_substitute; endif; ENDCASE; update(current_window); endloop; endprocedure ! Page 20 ! !+ ! Line mode command parser. This will return the next token from the line. ! ! edt$x_line - what is left of the current line mode command !- procedure edt$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 := edt$x_terminators + additional_terms; edit(edt$x_line,trim_leading); line_length := length(edt$x_line); term_char := edt$x_empty; If (line_length = 0) then RETURN edt$x_empty; endif; ! ! Did we find =, as in =buffer ! char := substr(edt$x_line,1,1); if (char = '=') then edt$x_line := substr(edt$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; edt$x_line := substr(edt$x_line,2,line_length); return edt$x_empty; endif; cp := 2; quoted := 0; loop exitif cp > line_length; char := substr(edt$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(edt$x_line,1,(cp - 1)); edt$x_line := substr(edt$x_line,(cp+1),line_length); return token; endprocedure ! Page 21 !+ ! Find the buffer by name !- procedure edt$find_buffer ( buffer_name) ! support routine for line mode LOCAL upcased_name , buffer_ptr ; upcased_name := buffer_name; change_case(upcased_name,upper); buffer_ptr := get_info(buffers,'first'); loop exitif buffer_ptr = 0; exitif upcased_name = get_info(buffer_ptr,'name'); buffer_ptr := get_info(buffers,'next'); endloop; return buffer_ptr; endprocedure !+ ! Process a range specifier. We will return either a range or a buffer. !- procedure edt$range_specification ( spec ) ! support routine for line mode LOCAL r_index ; !+ ! What did they give us !- r_index := index(edt$x_ranges,(' '+spec)); r_index := ( (r_index + edt$x_range_length - 1) / edt$x_range_length); CASE r_index from 0 TO 2 [0]: message('Unsupported range specification: ' + spec); return 0; [1]: ! SELECT edt$select_range; if (edt$x_select_range = 0) then message("No Select Active"); return 0; else return edt$x_select_range; endif; [2]: !WHOLE r_index := current_buffer; return r_index; ENDCASE; message('Unsupported range specification: ' + spec); return 0; endprocedure ! Page 22 !+ ! Process the line mode =buffer command !- procedure edt$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 := edt$next_token(edt$x_empty,term_char); if (buffer_name = edt$x_empty) then message('No buffer specified'); return 0; endif; ! IF it exists just map to it. buffer_ptr := edt$find_buffer(buffer_name); if buffer_ptr = 0 then edt$x_make_buf_var := buffer_name; create_variable_string := edt$x_make_buf_var + "_buffer := create_buffer(edt$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); return 1; endprocedure ! Page 23 !+ ! EDT line mode Show command !- procedure edt$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 := edt$next_token(edt$x_empty,term_char); if (show_type = edt$x_empty) then message('You must provide an option to SHOW'); return 0; endif; show_index := index(edt$x_shows,(' ' + show_type)); show_index := ((show_index + edt$x_show_length - 1) / edt$x_show_length); CASE show_index FROM 0 TO 6 [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; 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,edt$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 (edt$x_search_begin) then buf := buf + 'BEGIN ' else buf := buf + 'END ' endif; if (edt$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')) + ' - ' + edt$x_version); [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 (edt$x_wrap_position = 0) then message ('Nowrap'); else message('Wrap setting: ' + str (edt$x_wrap_position)); endif; return 1; ENDCASE; endprocedure ! Page 24 ! !+ ! Edt line mode SET command !- procedure edt$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 := edt$next_token(edt$x_empty,term_char); if (set_type = edt$x_empty) then message('Need to SET something!'); return 0; endif; set_index := index(edt$x_sets,(' ' + set_type)); set_index := ((set_index + edt$x_set_length - 1) / edt$x_set_length); CASE set_index FROM 0 to 5 [0]: message('Unsupported SET option: ' + set_type); return 0; [1]: ! SET SCREEN temp_value1 := edt$next_token(edt$x_empty,term_char); if (temp_value1 = edt$x_empty) then message('Missing width parameter for SET SCREEN'); return 0; endif; temp_value1 := int(temp_value1); set(width,main_window,temp_value1); set(width,message_window,temp_value1); update(message_window); [2]: ! SET WRAP temp_value1 := edt$next_token(edt$x_empty,term_char); if (temp_value1 = edt$x_empty) then message('Missing parameter to SET WRAP'); return 0; endif; temp_value1 := int(temp_value1); if (temp_value1 > 255) OR ( temp_value1< 0 ) then message("Numeric value illegal"); return 0 endif; if (temp_value1 = 0) then if (edt$x_wrap_position <> 0) then undefine_key(key_name(' ')); endif; else if (edt$x_wrap_position = 0) then define_key('edt$wrap_word',key_name(' ')); endif; endif; edt$x_wrap_position := temp_value1; [3]: ! SET CURSOR temp_value1 := edt$next_token(':',term_char); if (temp_value1 = edt$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 := edt$next_token(':',term_char); if (temp_value2 = edt$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(main_window,'visible_length') - temp_value2; set(scrolling,main_window,ON,temp_value1,temp_value2,0); [4]: ! SET TAB temp_value1 := edt$next_token(edt$x_empty,term_char); if (temp_value1 = edt$x_empty) then message('Missing parameter to SET TAB'); return 0; endif; temp_value1 := int(temp_value1); if (temp_value1 > 255) OR ( temp_value1< 0 ) then message("Numeric value illegal") else edt$x_tab_size := temp_value1; edt$x_tab_goal := edt$x_tab_size; edt$x_tabs_set := 1; endif; [5]: ! SET SEARCH set_type := edt$next_token(edt$x_empty,term_char); if (set_type = edt$x_empty) then message('Missing parameter to SET SEARCH'); return 0; endif; set_index := index(edt$x_searches,set_type); set_index := ((set_index + edt$x_searches_length - 1) / edt$x_searches_length); CASE set_index FROM 0 to 4 [0]: message('Unsupported SET option: ' + set_type); return 0; [1]: ! SET SEARCH GENERAL edt$x_search_case := no_exact; [2]: ! SET SEARCH EXACT edt$x_search_case := exact; [3]: !SET SEARCH BEGIN edt$x_search_begin := 1; [4]: ! SET SEARCH END edt$x_search_begin := 0; ENDCASE; ENDCASE; return 1; endprocedure ! Page 25 !+ ! Edt line mode Write command !- procedure edt$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 := edt$next_token(edt$x_empty,term_char); if (file_name = edt$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 := edt$next_token(':',term_char); if (range_specifier = edt$x_empty) then write_file(current_buffer,file_name); return 1; endif; ! Check for =buffer alone if (range_specifier = '=') then buffer_name := edt$next_token(edt$x_empty,term_char); if (buffer_name = edt$x_empty) then message ('No buffer specified'); return 0; endif; buffer_ptr := edt$find_buffer (buffer_name); 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 := edt$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 edt$x_select_range := 0; endif; return 1; endif; endprocedure ! Page 26 !+ ! Edt line mode INCLUDE command ! !- procedure edt$include ! support routine for line mode(include cmd) LOCAL file_name , equal_option , cur_buf, term_char ; !+ ! Get the file name !- file_name := edt$next_token(edt$x_empty,term_char); if (file_name = edt$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 := edt$next_token(edt$x_empty,term_char); if (equal_option <> edt$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 (edt$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 <> main_buffer) THEN set(no_write,cur_buf); ENDIF; endif; endif; ! Now read the file in read_file(file_name); return 1; endprocedure ! Page 27 !+ ! EDT line mode QUIT Command !- procedure edt$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 := edt$next_token('/',term_char); if (term_char = edt$x_empty) and (save_qualifier = 0) and (save_opt = edt$x_empty) then quit; return 1; endif; if (term_char = '/') then save_opt := edt$next_token(edt$x_empty,term_char); endif; if (save_opt <> 'SAVE') then message('Unsupported QUIT option'); return 0; else journal_close; endif; quit; return 1; endprocedure !+ ! Edt line mode EXIT command !_ procedure edt$exit ( save_qualifier ) !support routine for line mode(exit cmd) LOCAL term_char , out_name ; on_error ! If an error occurs here stop the EXIT if error <> tpu$_nojournal then return 0; endif; endon_error; out_name := edt$next_Token('/',term_char); if (term_char = '/') then save_qualifier := 1; out_name := edt$next_token(edt$x_empty,term_char); endif; 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 := edt$next_token(edt$x_empty,term_char); endif; if (out_name <> edt$x_empty) then set(output_file,main_buffer,out_name); else if (get_info(command_line,'read_only') = 1) then message('File specification required'); return endif; endif; write_file(main_buffer); set(no_write,main_buffer); exit; endprocedure ! Page 28 !+ ! EDT line mode SUBSTITUTE command !- procedure edt$line_mode_substitute ! support routine for line mode(subs cmd) local cp, line_length, old_index, temp_mark, remaining_line, term_char, old_string, new_string; ! ! 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] ! delimiter (edt$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 ! edit (edt$x_line, TRIM, OFF); ! Remember where we are temp_mark := mark(none); line_length := length (edt$x_line); if (edt$find_sub_delimiter (line_length, cp) = 0) then return 0; endif; old_string := substr (edt$x_line, 1, (cp - 1)); edt$x_line := substr (edt$x_line, (cp + 1), line_length); line_length := length (edt$x_line); if (edt$find_sub_delimiter (line_length, cp) = 0) then return 0; endif; new_string := substr (edt$x_line, 1, (cp - 1)); if (cp = line_length) ! There are no options then ! Just do one substitution in the current line RETURN edt$single_search_replace (old_string, new_string); else edt$x_line := substr (edt$x_line, (cp + 1), line_length); ! ! See if WHOLE was typed, if not issue an error message ! edit (edt$x_line, TRIM, UPPER, OFF); If (INDEX ('WHOLE', edt$x_line) <> 1) THEN message ('Invalid option for line mode SUBSTITUTE comand'); RETURN 0; endif; ! Search through entire buffer and replace starting at the beginning position (beginning_of (current_buffer)); edt$global_search_replace (old_string, new_string); ! position (temp_mark); endif; return 1; ENDPROCEDURE ! ! Find the next delimiter in the command line PROCEDURE edt$find_sub_delimiter (line_length, cp) !support routine for subs cmd cp := 1; loop if cp > line_length then message ('Delimiter for SUBSTITUTE could not be found'); RETURN 0; endif; exitif (substr(edt$x_line, cp, 1) = edt$x_subs_term); cp := cp + 1; endloop; return 1; ENDPROCEDURE ! Page 29 ! PROCEDURE edt$single_search_replace (string1, string2) !support routine for subs cmd ! ! This procedure performs a search through the current ! buffer and replaces one string with another if the ! original string is found on the current line LOCAL m1, r1, save_buf, temp_mark, msg_text, original_line, src_range; ! Return to caller if string not found ON_ERROR message ('No occurrences of ' + string1 + ' found in current line'); position (save_buf); position (temp_mark); RETURN 0; ENDON_ERROR; save_buf := current_buffer; temp_mark := mark(none); ! Copy a range of text which is the current line over to a temp ! buffer if (current_offset <> 0) then move_horizontal(-current_offset) endif; m1:=mark(none); move_horizontal(length(current_line)); r1:=create_range(m1,mark(none),none); position(show_buffer); erase(show_buffer); copy_text (r1); position(beginning_of(show_buffer)); ! Search through the temp buffer src_range := SEARCH (string1, forward); ! Search returns a range if found ! If not found it never gets here, from here go back and find ! the same string in the original buffer position(save_buf); ! We know we found it so go back if (current_offset <> 0) then move_horizontal(-current_offset) endif; src_range := SEARCH (string1, forward); ! Search returns a range if found 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; ENDPROCEDURE ! PROCEDURE edt$global_search_replace (string1, string2) !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; ! 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); RETURN 0; ENDON_ERROR; replacement_count := 0; LOOP src_range := SEARCH (string1, forward); ! Search returns a range if found 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; ENDLOOP; RETURN 1; ENDPROCEDURE ! Page 30 !+ ! EDT Move to the next word !- procedure edt$move_word ! kp2 (move word) if current_direction = forward then edt$move_word_f else !moveback edt$move_word_r endif endprocedure !moveword ! ! Move backwards a word ! procedure edt$move_word_r !support routine for move word (reverse) if edt$beg_word = 0 ! Move to beginning of word, back a line if none then move_horizontal(-1); endif; endprocedure ! ! Move forwards a word ! procedure edt$move_word_f !support routine for move word (forward) if edt$end_word = 0 then move_horizontal(1); endif; endprocedure ! ! EDT Delete to beginning of word ! procedure edt$del_beg_word ! support routine for delete word (forward) LOCAL temp_length ; temp_length := edt$beg_word; ! Go to beginning of word if temp_length = 0 then if mark(none) = end_of (current_buffer) then move_horizontal (-1); else append_line; endif; edt$x_deleted_word := ascii(10); else edt$x_deleted_word := erase_character(temp_length) endif; endprocedure ! ! Find the beginning of word ! procedure edt$beg_word !support routine for move word LOCAL temp_char , temp_length ; if current_offset = 0 then return 0; endif; move_horizontal(-1); ! Skip current character temp_length := 1; ! ! Count any spaces ! temp_char := current_character; loop exitif current_offset = 0; exitif temp_char <> ' '; 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(edt$x_word,temp_char) = 0) then loop exitif current_offset = 0; move_horizontal(-1); temp_char := current_character; if (index(edt$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 edt$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(edt$x_forward_word,forward); temp_length:=length(temp_range); move_horizontal(temp_length); return temp_length; endprocedure ! Page 31 !+ ! EDT next Line !- procedure edt$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 32 !+ ! Process the 7 key, PAGE. !- procedure edt$page !kp7 (move to next page) LOCAL dir , next_page ; on_error if error = tpu$_strnotfound then if dir = REVERSE then position(beginning_of(current_buffer)) else position(end_of(current_buffer)) endif; endif; return endon_error dir := current_direction; if dir = FORWARD then move_horizontal(1) else move_horizontal(-1) endif; next_page := search(ascii(12),dir); position(beginning_of(next_page)); endprocedure; !+ ! EDT 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 edt$paste !gold kp6 (paste selected text) LOCAL paste_text ; if (beginning_of(paste_buffer) <> end_of(paste_buffer)) then copy_text(paste_buffer); append_line; endif; endprocedure ! ! EDT REPLACE ! procedure edt$replace !gold kp9 (replace) edt$select_range; if ( edt$x_select_range <> 0) then erase(edt$x_select_range); edt$paste; edt$x_select_range:=0; else message("No Select Active"); edt$x_repeat_count := 1; endif; endprocedure ! Page 33 !+ ! EDT RESET !- procedure edt$reset ! gold kepypad dot(reset) edt$x_beginning_of_select := 0; set(forward, current_buffer); erase(message_buffer); endprocedure !+ ! EDT rubout key !- !Delete the previous character ! procedure edt$rubout ! rubout key (erase prev chr) edt$x_deleted_char := erase_character(-1); if edt$x_deleted_char = edt$x_empty then edt$x_deleted_char := ascii(10); append_line endif; endprocedure ! Page 34 !+ ! EDT Search !- procedure edt$search !gold pf3 (search) LOCAL search_term , direction_distance, saved_position; 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 edt$x_search_string:=read_line('Search for: '); if (current_direction = forward) then direction_distance := edt$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); 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); 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); edt$x_search_range := search(edt$x_search_string,current_direction,edt$x_search_case); if (edt$x_search_range <> 0) then IF (edt$x_search_begin) ! SET SEARCH BEGIN is in effect THEN position(beginning_of(edt$x_search_range)); ELSE ! SET SEARCH END is in effect position(end_of(edt$x_search_range)); move_horizontal(1); endif; else move_horizontal(-direction_distance); endif; endprocedure !+ ! Search for the same thing again !- procedure edt$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 (edt$x_search_begin = 0) and (direction_distance = -1) THEN ! move to beginning of range first) IF edt$x_search_range <> 0 THEN saved_position:=mark(none); ! save place in case of error position(beginning_of(edt$x_search_range)); ENDIF; ENDIF; move_horizontal(direction_distance); edt$x_search_range := search(edt$x_search_string,current_direction,edt$x_search_case); if (edt$x_search_range <> 0) then IF (edt$x_search_begin) ! SET SEARCH BEGIN is in effect THEN position(beginning_of(edt$x_search_range)); ELSE ! SET SEARCH END is ine effect position(end_of(edt$x_search_range)); move_horizontal(1); endif; else move_horizontal(-direction_distance); endif; endprocedure ! Page 35 !+ ! EDT SECTION Key Emulation !- procedure edt$section ( direction_to_move ) !kp8 (section) if direction_to_move = forward then move_vertical(edt$x_section_distance) else move_vertical(- edt$x_section_distance) endif; move_horizontal(- current_offset); endprocedure !+ ! EDT SELECT !- procedure edt$select !keypad dot (select) if edt$x_beginning_of_select <> 0 then message("Select already active") else edt$x_beginning_of_select := select(edt$x_video); endif; endprocedure !+ ! EDT SUBSTITUTE !- procedure edt$substitute !gold enter (substitute) local r_len; on_error if error = tpu$_strnotfound then edt$cancel_subs; endif; return; endon_error if (edt$x_search_range = 0) then edt$cancel_subs; else ! Make sure we're positioned on the search range ! and haven't moved off if (edt$on_search_range = 1) then erase (edt$x_search_range); edt$paste; edt$x_search_range:=search(edt$x_search_string,current_direction); IF (edt$x_search_begin) ! SET SEARCH BEGIN is in effect THEN position(beginning_of(edt$x_search_range)); ELSE ! SET SEARCH END is ine effect position(end_of(edt$x_search_range)); move_horizontal(1); endif; ! If we're not still on the search range, then cancel the substitution else edt$cancel_subs; endif; endif; endprocedure procedure edt$cancel_subs ! support routine for substitute message("No Select Active"); edt$x_repeat_count := 1; endprocedure ! Page 36 !+ ! Tab the current line !_ procedure edt$tab !tab key LOCAL tab_position; ! ! if not at the beginning of the line just insert a tab ! if (current_offset <> 0) or (edt$x_tabs_set = 0) then copy_text(ascii(9)); else ! ! insert the correct number of tabs and spaces to reach the desired position ! tab_position := 0; loop exitif ((tab_position + 8) > edt$x_tab_goal); tab_position := tab_position + 8; copy_text(ascii(9)); endloop; if (((edt$x_tab_goal / 8) * 8) <> edt$x_tab_goal) then loop exitif ((tab_position + 1) > edt$x_tab_goal); tab_position := tab_position + 1; copy_text(' '); endloop; endif; endif; endprocedure !+ ! Procedures for adjustable tabs !- !+ ! Do a tabs adjust for the select region !- procedure edt$tab_adjust !ctrl t (adjust tabs) LOCAL start_range , end_range , tab_level , adjust_level , original_goal ; !+ ! Get the range to adjust !- edt$select_range; if (edt$x_select_range = 0) then message('No select active'); return 0; endif; adjust_level := edt$x_repeat_count; edt$x_repeat_count := 1; original_goal := edt$x_tab_goal; start_range := beginning_of(edt$x_select_range); end_range := end_of(edt$x_select_Range); edt$x_select_range := 0; position(start_range); move_horizontal(-current_offset); loop exitif mark(none) > end_range; !+ ! Go to beginning of line. ! Calculate tab depth for this line ! Strip off spaces and tabs at beginning of line. ! Set up new tab goal ! Call the tab routine. !- if length (current_line) > 0 then loop exitif (current_character <> ' ') AND (current_character <> ' '); move_horizontal(1); endloop; tab_level := get_info(current_buffer,'offset_column') / edt$x_tab_size; edt$x_Tab_goal := (tab_level + adjust_level) * edt$x_tab_size; if (edt$x_tab_goal < 0) then edt$x_tab_goal := 0 endif; erase_character(-current_offset); edt$tab; endif; move_vertical(1); move_horizontal(-current_offset); endloop; edt$x_tab_goal := original_goal; endprocedure ! Page 37 !+ ! EDT UNDELETE CHARACTER !- procedure edt$undelete_char !gold comma (undelete character) if edt$x_deleted_char <> ascii(10) then copy_text (edt$x_deleted_char) else split_line endif; move_horizontal (-1); endprocedure !+ ! EDT UNDELETE LINE !- procedure edt$undelete_line !gold pf4 (undelete line) LOCAL temp_length; if (edt$x_appended_line) then split_line; copy_text (edt$x_deleted_line); move_horizontal (-(current_offset + 1)); else temp_length := length(edt$x_deleted_line); if (edt$x_delete_crlf = 1) and (mark(none) <> end_of(current_buffer)) then split_line; move_horizontal(-1); endif; copy_text(edt$x_deleted_line); move_horizontal( - ( temp_length ) ); endif; endprocedure ! ! EDT Undelete WORD procedure edt$undelete_word !gold keypad minus(undelete word) local two_lines; if edt$x_deleted_word <> ascii(10) then if substr(edt$x_deleted_word, 1, 1) = ascii(10) then split_line; copy_text(substr(edt$x_deleted_word, 2, length(edt$x_deleted_word) - 1)); else copy_text(edt$x_deleted_word) ; endif; move_horizontal( - length (edt$x_deleted_word)); else split_line; move_horizontal (-1); endif; endprocedure ! Page 38 procedure edt$on_end_of_line !support routine for undelete if (current_character = edt$x_empty) then edt$on_end_of_line := 1 else edt$on_end_of_line := 0 endif; endprocedure ! Page 39 !+ ! Procedure to wrap the word to the next line. Bound to space key when ! a SET WRAP is done. !- procedure edt$wrap_word ! space key (wrap word) LOCAL word_size , trash_space ; if edt$x_wrap_position = 0 then return endif; if current_column > edt$x_wrap_position then word_size := edt$beg_word; split_line; move_horizontal(word_size); endif; copy_text(' '); endprocedure ! Page 40 ! ! Bind all EDT keys ! ! Procedure to define keys to emulate EDT ! procedure EDT$define_keys !define all keys LOCAL temp_string ; ! ! Define all the keys ! ! arrow keys ! define_key("shift(current_window,-8)", key_name(right,shift_key),"shift_right"); ! shift right define_key("shift(current_window,8)", key_name(left,shift_key),"shift_left"); ! shift left define_key("move_horizontal(-1)",left,"left_arrow"); ! left define_key("move_horizontal(1)",right,"right_arrow"); ! right define_key("move_vertical(1)",down,"down_arrow"); ! down define_key("move_vertical(-1)",up,"up_arrow"); ! up ! ! Editing keypad keys ! define_key('edt$search',E1,"find"); ! find define_key('edt$paste',E2,"paste"); ! insert here define_key('edt$cut',E3,"cut"); ! remove define_key("edt$select",E4,"select"); ! select define_key('edt$section(reverse)',E5,"sect"); ! prev screen define_key('edt$section(forward)',E6,"sect"); ! next screen ! ! Function keys ! define_key("edt$keypad_help",help,"keypad_diagram"); ! help diagram define_key("edt$help(edt$x_empty)", key_name(help,shift_key),"vaxtpu_help"); ! help on topic ! ! Page 41 ! ! keypad keys ! !first row ! define_key("edt$keypad_help",pf2,"keypad_diagram"); ! help diagram define_key("edt$help(edt$x_empty)", key_name(pf2,shift_key),"vaxtpu_help"); ! help on topic define_key('edt$search_next',PF3,"fndnxt"); ! find next define_key('edt$search', key_name(PF3,shift_key),"find"); ! find define_key('edt$delete_line',pf4,"del_l"); ! delete line define_key('edt$undelete_line', key_name(pf4,shift_key),"und_l"); ! undelete line ! ! second row ! define_key('edt$page',kp7,"page"); ! page define_key("edt$command", key_name(kp7,shift_key),"command"); ! command key define_key('edt$section(current_direction)', Kp8,"sect"); ! section define_key('edt$fill', key_name(kp8,shift_key),"fill"); ! fill define_key('edt$append',kp9,"append"); ! append define_key('edt$replace', key_name(kp9,shift_key),"replace"); ! replace define_key('edt$delete_end_word',minus,"del_w") ; ! delete word define_key('edt$undelete_word', key_name(minus,shift_key),"und_w"); ! undelete word ! !third row ! define_key('set(forward,current_buffer)',Kp4,"advance"); ! advance define_key('position(end_of(current_buffer))', key_name(kp4,shift_key),"bottom"); ! bottom define_key('set(reverse,current_buffer)',Kp5,"backup"); ! backup define_key('position(beginning_of(current_buffer))' ,key_name(kp5,shift_key),"top"); ! top define_key("edt$cut",kp6,"cut"); ! Cut define_key("edt$paste",key_name(kp6,shift_key),"paste");! Paste define_key('edt$delete_char',comma,"del_c"); ! delete chr define_key('edt$undelete_char', key_name(comma,shift_key),"und_c"); ! undelete character ! Page 42 ! !fourth row ! define_key('edt$move_word',kp1,"word"); ! move word define_key('edt$change_case', key_name(kp1,shift_key),"chngcase"); ! change case define_key('edt$end_of_line',kp2,"eol"); ! end of line define_key('edt$delete_to_eol', key_name(Kp2,shift_key),"del_eol"); ! delete to end of line define_key( 'if current_direction=forward then move_horizontal'+ '(1) else move_horizontal(-1) endif', Kp3,"char"); ! move char define_key( 'copy_text(ascii(int(read_line("SPECINS : "))))', key_name(kp3,shift_key),"specins"); ! special insert ! !fifth row ! define_key('edt$next_prev_line',kp0,"line"); ! move to beg of line define_key('split_line;move_horizontal(-1)', key_name(kp0,shift_key),"open_line"); ! open line define_key("edt$select",period,"select"); ! Select define_key("edt$reset", key_name(period,shift_key),"reset"); ! RESET define_key('edt$substitute', key_name(enter,shift_key),"subs"); ! substitute ! Page 43 ! ! control keys ! define_key('edt$x_tab_goal := current_column-1', key_name('A',shift_key),"ctrl_a"); ! gold ctrl a define_key('edt$x_tab_goal := current_column-1', ctrl_a_key,"ctrl_a"); ! ctrl a define_key('edt$decrease_tab', key_name('D',shift_key),"ctrl_d"); ! gold ctrl d define_key('edt$decrease_tab', ctrl_d_key,"ctrl_d"); ! ctrl d define_key('edt$increase_tab', key_name('E',shift_key),"ctrl_e"); ! gold ctrl e define_key('edt$increase_tab', ctrl_e_key,"ctrl_e"); ! ctrl e define_key('edt$tab',tab_key,"ctrl_i"); ! ctrl i (tab key) define_key('edt$del_beg_word',f13,"ctrl_j"); ! ctrl j (line feed) define_key('edt$del_beg_word',lf_key,"ctrl_j"); ! ctrl j (line feed) define_key('edt$define_key',ctrl_k_key,"ctrl_k"); ! ctrl k define_key('copy_text(ascii(12))',ctrl_l_key,"ctrl_l"); ! ctrl l define_key("refresh",ctrl_r_key,"ctrl_r"); ! ctrl r define_key('edt$tab_adjust', key_name('T',shift_key),"ctrl_t"); ! gold ctrl t define_key('edt$tab_adjust', ctrl_t_key,"ctrl_t"); ! ctrl t define_key('edt$delete_beg_line',ctrl_u_key,"ctrl_u"); ! ctrl u define_key("refresh",key_name('W',shift_key),"ctrl_w"); ! gold ctrl w define_key("refresh",ctrl_w_key,"ctrl_w"); ! ctrl w define_key('edt$Line_mode',ctrl_z_key,"ctrl_z"); ! ctrl z ! define_key("split_line",ret_key,"return"); ! return define_key('edt$backspace',f12,"backspace"); ! Backspace define_key('edt$backspace',bs_key,"backspace"); ! Backspace define_key('edt$rubout',del_key,"delete") ; ! rubout temp_string := 'set(status_line,info_window,edt$x_info_stats_video,'+ '"Press CTRL-F to remove INFO_WINDOW and resume editing");unmap(info_window)'; define_key(temp_string,ctrl_f_key,"ctrl_f"); ! Unmap the show window ! ! Page 44 ! ! Define the numeric keys for use with edt$gold_number ! these are necessary to emulate EDT repeat counts ! define_key('edt$gold_number("0")',key_name('0',shift_key)); define_key('edt$gold_number("1")',key_name('1',shift_key)); define_key('edt$gold_number("2")',key_name('2',shift_key)); define_key('edt$gold_number("3")',key_name('3',shift_key)); define_key('edt$gold_number("4")',key_name('4',shift_key)); define_key('edt$gold_number("5")',key_name('5',shift_key)); define_key('edt$gold_number("6")',key_name('6',shift_key)); define_key('edt$gold_number("7")',key_name('7',shift_key)); define_key('edt$gold_number("8")',key_name('8',shift_key)); define_key('edt$gold_number("9")',key_name('9',shift_key)); define_key('edt$gold_number(edt$x_empty)',key_name('+',shift_key)); define_key('edt$gold_number("-")',key_name('-',shift_key)); ! endprocedure ! Page 45 ! This dummy procedure is here as a hook for local ones. ! procedure tpu$local_init ! local initialization tpu$local_init := 1; endprocedure ! ! INITIALIZATION PROCEDURE ! ! This procedure is invoked to initialize the editing session. The windows ! and buffers are created here. ! procedure tpu$init_procedure ! initialization procedure LOCAL temp, output_file_name , parsed_output_file_name, input_file_name_only, screen_length ; ! ! Initialize our variables edt$init_variables; ! ! Create all the necessary default buffers and windows ! ! ! Get the show buffer next, but don't map it yet show_buffer := create_buffer("SHOW"); set(tab_stops,show_buffer,'21 33'); ! For use with line mode emulator set(eob_text,show_buffer,edt$x_empty); set(no_write,show_buffer); set(system,show_buffer); ! ! Now do the paste buffer paste_buffer := create_buffer("PASTE"); set(eob_text,paste_buffer,"[End of PASTE]"); set(no_write,paste_buffer); set(system,paste_buffer); ! screen_length := get_info(SCREEN,"visible_length"); ! ! Create the prompt area ! set(prompt_area,(screen_length - 2),1,reverse); ! ! Create the window for the show buffer and help buffer to be mapped to info_window :=create_window( 1,(screen_length - 3),ON); set(status_line,info_window,edt$x_info_stats_video,'Press CTRL-F to remove INFO_WINDOW and resume editing'); set(width,info_window,get_info(screen,'width')); set(pad,info_window,on); set(video,info_window,reverse); ! ! Do the message buffer and window first. Let's get this ready for future ! information ! message_buffer := create_buffer("MESSAGE"); set(eob_text,message_buffer,edt$x_empty); set(permanent,message_buffer); set(no_write,message_buffer); set(system,message_buffer); set(max_lines,message_buffer,20); message_window := create_window((screen_length-1),2,OFF); set(video,message_window,none); map(message_window,message_buffer); ! ! Now position to another buffer. This is to not have the EOB line as ! the current line when the window gets mapped and updated. We want to ! see messages ! position(paste_buffer); ! ! Now for the main buffer. Create it from the input file input_file := get_info(command_line,'file_name'); !+ if /nocreate is present and file does not exis,then exit if (get_info(command_line,'create') = 0) then ! /nocreate specified temp:=file_parse(input_file); if (file_search(temp)=edt$x_empty ) AND (input_file <> edt$x_empty) then ! exit immediately if file not there message('Input file does not exist: '+temp); exit else temp:=file_search(edt$x_empty) ! reset endif; endif; main_buffer := create_buffer("MAIN",input_file); if (get_info(command_line,'read_only') = 1) then set(no_write,main_buffer); endif; if (get_info(command_line,'output') <> 1) then set(no_write,main_buffer); else output_file_name := get_info(command_line,'output_file'); if (output_file_name <> edt$x_empty) then ! The output file should be written to the current directory by default ! unless there is another directory specified in the output_file_name. ! We need to use sys$disk:[] as the default file specification so that ! the output file won't be written to the same directory as the input ! file if an input file directory is explicitly specified on the command line. ! We also DON'T want the node, device or directory of the input file, just ! the name. input_file_name_only := file_parse (input_file, edt$x_empty, edt$x_empty, NAME) + file_parse (input_file, edt$x_empty, edt$x_empty, TYPE); parsed_output_file_name := file_parse (output_file_name, 'sys$disk:[]', input_file_name_only); if parsed_output_file_name <> edt$x_empty then set(output_file,main_buffer,parsed_output_file_name); ! Want this buffer to be considered modified so it will be written on exit ! for use especially with MAIL/EDIT position (main_buffer); split_line; append_line; ! Marks it as modified endif; endif; endif; set(eob_text,main_buffer,"[End of MAIN]"); set(system,main_buffer); main_window := create_window(1,(screen_length - 3),OFF); ! Make the cursor limits like EDT's set(scrolling,main_window,ON,6,7,0); map(main_window,main_buffer); ! ! Start journalling ! if (get_info(command_line,'journal') = 1) and (get_info(command_line,'read_only') <> 1) then default_journal_name := "sys$disk:[]"; if input_file = edt$x_empty then input_file_name_only := "TPU.TJL"; else input_file_name_only := file_parse (input_file, edt$x_empty, edt$x_empty, NAME) + ".TJL"; endif; journal_file := get_info (command_line,'journal_file'); journal_file := file_parse (journal_file, default_journal_name, input_file_name_only); journal_open (journal_file); endif; ! ! Go to the current position in the main buffer ! position(main_window); tpu$local_init; endprocedure ! Page 46 !+ ! This is the code to be executed when the section is being built !- edt$define_keys; ! bind keys !+ ! Relinguish memory taken up (unnecessarily) by the edt$define_keys procedure. !- compile ('procedure edt$define_keys endprocedure'); save('sys$disk:[]edtsecini'); quit