! page 1 ! EDT_PLUS Section 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. !************************************************************************ ! ! Functional July 15, 1986 by Ted Nieland ! ! Enhanced: ! ! ! To activate after revisions: ! ! $EDIT/TPU/NOSECTION/COMMAND=this_file ! $EDIT/TPU/SECTION=EDTP$TPU:EDTPSECINI.NEW ! and play with any modified commands; if all is OK, then ! $ RENAME EDTP$TPU:EDTPSECINI.NEW EDTP$TPU:*.TPU$SECTION ! ! page 2 ! Table of Contents as of 15-Jul-1985 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! EDTP$init_variables 5 initialize global variables ! EDTP$append 8 EDT append key ! EDTP$backspace 8 EDT backspace key ! EDTP$TPU_Command 9 TPU Command Loop ! EDTP$change_case 10 EDT Changecase key ! EDTP$cut 11 EDT Cut to Paste Buffer ! EDTP$on_search_range 11 Search and subs support routine ! EDTP$select_range 12 cut support routine ! EDTP$decrease_tab 13 EDT tab support routine ! EDTP$DEFINE_KEY 13 EDT Define Key ! EDTP$delete_char 14 EDT delete character ! EDTP$delete_beg_line 15 EDT delete to beginning of line ! EDTP$delete_end_word 15 EDT delete to end of word ! EDTP$delete_line 16 EDT delete line ! EDTP$delete_to_eol 16 EDT delete to end of line ! EDTP$end_of_line 17 EDT move to end of line ! EDTP$fill 17 EDT Fill select range ! EDTP$preserve_blanks 18 Support routine for fill ! EDTP$skip_leading_spaces 19 Support routine for fill ! EDTP$find_whiteline 19 Support routine for fill ! EDTP$skip_lines 20 Support routine for fill ! EDTP$gold_number 21 Gold repeat count support ! EDTP$help 23 Access to TPU HELP ! EDTP$increase_tab 23 Increase EDT tab level ! EDTP$keypad_help 24 Access keypad help ! EDTP$create_keypad_diagram 25 Create Keypad diagram ! EDTP$get_keypad_diagram 26 Restore Keypad diagram ! EDTP$Line_mode 27 Line mode (CTRL Z) ! EDTP$next_Token 29 Support for line mode ! EDTP$range_specification 30 Support for line mode ! EDTP$buffer 31 Support for line mode ! EDTP$show 32 Support for line mode ! EDTP$set 35 Support for line mode ! EDTP$write 38 Support for line mode ! EDTP$include 40 Support for line mode ! EDTP$quit 41 Support for line mode ! EDTP$exit 41 Support for line mode ! EDTP$line_mode_substitute 43 Support for line mode ! EDTP$find_sub_delimiter 44 Support for LM substitute ! EDTP$single_search_replace 45 Support for substitute and replace ! EDTP$global_search_replace 47 Support for substitute and replace ! EDTP$Replace_String 49 Replace string with second string ! EDTP$move_word 49 EDT move word ! EDTP$move_word_r 49 Support for move word ! EDTP$move_word_f 49 Support for move word ! EDTP$del_beg_word 50 EDT delete to beginning of word ! EDTP$beg_word 50 support for move word ! EDTP$end_word 51 support for delete word ! EDTP$next_prev_line 52 EDT move line ! EDTP$page 53 EDT move page ! EDTP$paste 53 EDT paste from PASTE buffer ! EDTP$replace 54 EDT replace from PASTE buffer ! page 3 ! EDTP$reset 55 EDT reset ! EDTP$rubout 55 EDT Delete previous character ! EDTP$search 55 EDT search ! EDTP$search_next 57 EDT search next ! EDTP$section 58 EDT section key ! EDTP$select 58 EDT Select region ! EDTP$substitute 58 EDT substitute (GOLD ENTER) ! EDTP$cancel_subs 58 Support for substitute ! EDTP$Set_Tabs 59 Set special tabs ! EDTP$Show_Tabs 61 Show current tabs ! EDTP$Tab 61 Tab Key ! EDTP$Tab_Adjust 62 Adjust tabs in region ! EDTP$Set_beginning_Tabs 63 Set tabs at beginning of seesion ! EDTP$User_commands 65 Read in and execute user file(s) ! EDTP$get_out 66 Exit from editor ! EDTP$Prompt_On_Exit 67 Exit requesting filename ! EDTP$Check_Clear 68 Clear message feature ! EDTP$INSERT_RULER 69 Insert ruler to buffer ! EDTP$Insert_DCL_Comment 69 Insert DCL Comment buffer ! EDTP$Insert_FORT_Comment 69 Insert FORTRAN Comment buffer ! EDTP$RESTORE 70 Restore position of marker ! EDTP$find_buffer 71 Find buffer by name ! EDTP$Set_buffer 72 Set to specified buffer ! EDTP$main_buf 74 Set to main buffer ! EDTP$Write_Buffer 75 Write out specified buffer ! EDTP$erase_buf 76 Erase specified buffer ! EDTP$tab_jump 77 Jump 8 characters ! EDTP$swap_2_characters 77 Switch positions of next 2 characters ! EDTP$show_buf 78 Show all buffers ! EDTP$Remove_Page_Marks 79 Remove all page marks ! EDTP$Insert_Page_Marks 80 Insert page marks ! EDTP$top_parag 82 Move to top of paragraph ! EDTP$end_parag 82 Move to end of paragraph ! EDTP$end_sent 83 Move to end of sentance ! EDTP$top_sent 84 Move to beginning of sentance ! EDTP$fill_parag 85 Fill current paragraph ! EDTP$GET_KEY_INFO 86 Get comment on specified key ! EDTP$swap_delim 87 switch word delimmitters ! EDTP$Set_parameters 88 Set WP or PROG parameters ! EDTP$find_line 88 Find line by number ! EDTP$Make_windows 89 Create windows ! EDTP$Change_Windows 92 Switch Windows ! EDTP$include_file 92 Include file at cursor ! EDTP$overstrike 92 Switch insert and overstrike modes ! EDTP$Set_forward 92 Set buffer direction forward ! EDTP$Set_reverse 92 Set buffer direction reverse ! EDTP$Change_Width 93 Change 80, 132 screen widths ! EDTP$Set_Search 94 Set Search mode (General,Exact) ! EDTP$Set_Wrap 94 Switch between defined values ! EDTP$KUT 94 Cut to specified buffer ! EDTP$COPY 95 Copy to specified buffer ! EDTP$COPY_TO_END_OF_BUFFER 96 Copy to end of specified buffer ! EDTP$PASTE_Buf 97 Paste specified buffer ! EDTP$FORTRAN_HELP 98 Access FORTRAN HELP ! EDTP$DCL_HELP 98 Access DCL HELP ! EDTP$PL1_HELP 98 Access PL1 HELP ! EDTP$EDT_HELP 98 Access EDTP HELP ! EDTP$SPAWN 99 SPAWN specified command ! EDTP$find_beg_of_line 99 Support for Preserve_Blanks ! page 4 ! EDTP$return 100 RETURN Key auto indent ! EDTP$motion 101 Support for arrow keys ! EDTP$Learning 102 Start Learn Mode ! EDTP$Stop_Learn 102 Error on stop learn ! EDTP$Stop_Learn_X 102 Stop Learn Key ! EDTP$undelete_char 104 Replace last deleted character ! EDTP$undelete_line 104 Replace last deleted line ! EDTP$undelete_word 104 Replace last deleted word ! EDTP$on_end_of_line 105 Support Undelete ! EDTP$wrap_word 105 Wrap Feature support ! EDTP$Set_Status_Line 106 Set Status line for window ! EDTP$Calc_Position 106 Support for Column Cut and Paste ! EDTP$Column_Cut 107 Column (Rectangular) Cut ! EDTP$Column_Paste 110 Column (Rectangular) Paste ! EDTP$Column_Cut_or_Paste 112 Column (Rectangular) Cut and Paste Setup ! EDTP$DEFINE_KEYs 113 Define all keys ! TPU$local_init 118 Local Dummy procedure ! TPU$init_procedure 118 Initialize Procedure ! page 5 ! ! Procedures with names beginning with EDTP$ are EDT-PLUS commands. These ! procedures are subject to change. User-written procedures should not ! begin with EDTP$. Globals in user-written procedures should not begin ! with EDTP$ ! PROCEDURE EDTP$init_variables ! initialize global variables LOCAL Counter; ! ! Initialize some variables ! ! ! Create the null variable ! EDTP$x_empty := ''; EDTP$version := 'EDT-PLUS Keypad Emulator Version V1.0-001'; ! ! 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); ! ! Each command must be eleven characters long, with the first being a space TRUE:=1; FALSE:=0; EDTP$x_commands := ' XXXXXXXXXX CHANGE EXIT QUIT INCLUDE WRITE = SET SHOW HELP ' + ' SUBSTITUTE'; EDTP$x_command_length := 11; EDTP$x_range_length := 7; EDTP$x_make_buf_var := 'new'; EDTP$x_ranges := ' SELECT WHOLE REST BEFORE = '; EDTP$x_sets := ' SCREEN WRAP CURSOR TAB SEARCH'; EDTP$x_set_length := 7; EDTP$x_shows := ' BUFFER SEARCH SCREEN VERSION CURSOR WRAP '; 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 := 79; 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; ! 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$entry_mode := 'insert'; EDTP$Width_Size := 'NORMAL'; EDTP$Parameters := "WP"; EDTP$Tabs := ''; ! EDTP$x_tab_size := 4; EDTP$x_tab_goal := 8; EDTP$x_tab_set := 1; 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$x_wrap_position := 79; EDTP$Learn_On := 0; EDTP$Learn_Num := 0; EDTP$CLear_Message := "NO"; 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$Check_Clear; 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$TPU_HELP ('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 ; !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; change_case(character,invert); erase_character(1); copy_text(character); if current_direction <> forward then move_horizontal(-2); endif; return 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$Check_Clear; 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 Decrese_tab ! PROCEDURE EDTP$decrease_tab !ctrl d (decrease tab level) EDTP$x_tab_goal := EDTP$x_tab_goal - EDTP$x_tab_size; if (EDTP$x_tab_goal < 0) then EDTP$x_tab_goal := 0 endif; ENDPROCEDURE; ! ! 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"); EDTP$Check_Clear; 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 delete previous line 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 we are on eol 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 ! end of EOL ! ! 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$Check_Clear; 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 if current_line <> EDTP$x_empty then exitif; endif; 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 ! TPU help ! PROCEDURE EDTP$TPU_help (topic_param) set(status_line,info_window,EDTP$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 = EDTP$x_empty) then help_text('tpuhelp', read_line('Topic: '), on, help_buffer); else help_text('tpuhelp', topic_param, on, help_buffer); endif; ENDPROCEDURE ! ! EDTP Help ! PROCEDURE EDTP$help (topic_param) ! gold pf2 (help on topic) set(status_line,info_window,EDTP$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 = EDTP$x_empty) then help_text('EDTP$TPU:EDTPHELP', read_line('Topic: '), on, help_buffer); else help_text('EDTP$TPU:EDTHELP', topic_param, on, help_buffer); endif; ENDPROCEDURE ! PROCEDURE EDTP$increase_tab !ctrl e (increase tab level) EDTP$x_tab_goal := EDTP$x_tab_goal + EDTP$x_tab_size; 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'); EDTP$Check_Clear; 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; !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 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 ('EDTP$TPU:EDTPHELP', '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('EDTP$TPU:EDTPHELP','keypad_dia',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; ! Now delete the 5 spaces at the beginning of each line loop exitif mark(none) = end_of(EDTP$x_keypad_buffer); erase_character(3); move_vertical(1); endloop; erase_line; position(beginning_of(EDTP$x_keypad_buffer)); ENDPROCEDURE ! page 27 PROCEDURE EDTP$Line_mode(Num_lines) !ctrl z (line mode) LOCAL command_name , command_status , term_char , old_position, original_line, org_line_length, new_line_length, command_index ; ! ! Keep looping until we see something that will cause us to exit. ! Right now this is only the Change command ! LOOP IF (Num_lines = EDTP$Single_line) THEN EDTP$x_line := READ_LINE('EDTP Command >'); ELSE 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 change_case(EDTP$x_line,upper); ! What command is it? command_name := EDTP$next_token('/',term_char); if (command_name = EDTP$x_empty) then command_name := 'XXXX'; 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 0 TO 11 [0]: message(command_name + ' not supported') ; EDTP$Check_Clear; [2]: exitif; [3]: if (term_char = '/') then command_status := EDTP$exit(1); else command_status := EDTP$exit(0); endif; [4]: if (term_char = '/') then command_status := EDTP$quit(1); else command_status := EDTP$quit(0); endif; [5]: command_status := EDTP$include [6]: command_status := EDTP$write [7]: command_status := EDTP$buffer [8]: command_status := EDTP$set ! page 28 [9]: command_status := 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); command_status := EDTP$line_mode_substitute; POSITION(old_position); 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; edit(EDTP$x_line,trim_leading); line_length := length(EDTP$x_line); 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 ; ! ! 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 2 [0]: message('Unsupported range specification: ' + spec); EDTP$Check_Clear; return 0; [1]: ! SELECT EDTP$select_range; if (EDTP$x_select_range = 0) then message("No Select Active"); EDTP$Check_Clear; return 0; else return EDTP$x_select_range; endif; [2]: !WHOLE r_index := current_buffer; return r_index; ENDCASE; message('Unsupported range specification: ' + spec); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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); EDTP$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'); EDTP$Check_Clear; 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 6 [0]: message('Unsupported SHOW option: ' + show_type); EDTP$Check_Clear; 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); EDTP$Check_Clear; [3]: ! SHOW SCREEN buf := 'Screen Width is '; buf := buf + str(get_info(current_window,'width')); message(buf); EDTP$Check_Clear; [4]: ! SHOW VERSION message('TPU Version V'+str(get_info(system,'version'))+'.'+ str(get_info(system,'update')) + ' - ' + EDTP$version); EDTP$Check_Clear; ! 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); EDTP$Check_Clear; [6]: ! SHOW WRAP IF (EDTP$x_wrap_position = 0) then message ('Nowrap'); else message('Wrap setting: ' + str (EDTP$x_wrap_position)); endif; EDTP$Check_Clear; 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!'); EDTP$Check_Clear; 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 5 [0]: message('Unsupported SET option: ' + set_type); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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 := EDTP$next_token(EDTP$x_empty,term_char); if (temp_value1 = EDTP$x_empty) then message('Missing parameter to SET WRAP'); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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 := EDTP$next_token(EDTP$x_empty,term_char); if (temp_value1 = EDTP$x_empty) then message('Missing parameter to SET TAB'); EDTP$Check_Clear; return 0; endif; temp_value1 := int(temp_value1); EDTP$x_tab_size := temp_value1; EDTP$x_tab_goal := EDTP$x_tab_size; EDTP$x_tabs_set := 1; [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'); EDTP$Check_Clear; return 0; endif; set_index := index(EDTP$x_searches,set_type); set_index := ((set_index + EDTP$x_searches_length - 1) / EDTP$x_searches_length); ! page 37 CASE set_index FROM 0 to 4 [0]: message('Unsupported SET option: ' + set_type); EDTP$Check_Clear; 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; 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'); EDTP$Check_Clear; return 0; endif; buffer_ptr := EDTP$find_buffer (buffer_name); ! page 39 if (buffer_ptr = 0) then message ('Specified buffer does not exist'); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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 <> 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'); EDTP$Check_Clear; 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 ; on_error ! If an error occurs here stop the EXIT if error <> tpu$_nojournal then return 0; endif; endon_error; 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'); EDTP$Check_Clear; 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,main_buffer,out_name); else if (get_info(command_line,'read_only') = 1) then message('File specification required'); EDTP$Check_Clear; return endif; endif; write_file(main_buffer); set(no_write,main_buffer); exit; ENDPROCEDURE ! page 43 PROCEDURE EDTP$line_mode_substitute ! support routine for line mode(subs cmd) LOCAL cp, line_length, old_index, temp_mark, remaining_line, term_char, offset, whole_set, query_set, 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] [/query] ! 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 ! whole_set := "NO"; query_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) ! There are no options then ! Just do one substitution in the current line RETURN EDTP$single_search_replace (old_string, new_string, query_set); else EDTP$x_line := substr (EDTP$x_line, (cp + 1), line_length); ! page 44 ! ! See if WHOLE was typed, if not issue an error message ! edit (EDTP$x_line, TRIM, UPPER, OFF); offset := INDEX(EDTP$x_line,'W'); IF (offset<>0) THEN whole_set := "YES"; ENDIF; offset := INDEX(EDTP$x_line,'/Q'); IF (offset<>0) THEN query_set := "YES"; ENDIF; IF whole_set = "YES" THEN position (beginning_of (current_buffer)); EDTP$global_search_replace (old_string, new_string, query_set); ELSE EDTP$single_search_replace (old_string, new_string, query_set); ENDIF; ! position (temp_mark); endif; return 1; ENDPROCEDURE ! ! Find the next delimiter in the command line PROCEDURE EDTP$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'); ! ! Check to see if user has the buffer clearing feature ! EDTP$Check_Clear; 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 if the ! original string is found on the current line LOCAL m1, r1, save_buf, temp_mark, msg_text, original_line, src_range, temp_line, rev_range, response; ! Return to caller if string not found ON_ERROR message ('No occurrences of ' + string1 + ' found in current line'); ! ! Check to see if user has the buffer clearing feature ! EDTP$Check_Clear; 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 response := "Y" ; 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) ',1); CHANGE_CASE(response,UPPER); ENDIF; ! page 46 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 message('First occurrence of ' + string1 + ' replaced with ' + string2 + ' in current line'); EDTP$Check_Clear; RETURN 1; ELSE IF response = 'N' THEN rev_range := 0; 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 ! EDTP$Check_Clear; 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); ! temp_line := CURRENT_LINE + ' ?'; 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); EDTP$Check_Clear; 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 !moveword ! ! Move backwards a word ! PROCEDURE EDTP$move_word_r !support routine for move word (reverse) if EDTP$beg_word = 0 ! Move to beginning of word, back a line if none then 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 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; ! page 51 ! ! 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 ; if (beginning_of(paste_buffer) <> end_of(paste_buffer)) then copy_text(paste_buffer); append_line; endif; 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$Check_Clear; 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) EDTP$x_deleted_char := erase_character(-1); if EDTP$x_deleted_char = EDTP$x_empty then EDTP$x_deleted_char := ascii(10); append_line endif; ENDPROCEDURE ! ! EDTP Search ! PROCEDURE EDTP$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'); EDTP$Check_Clear; 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 ! page 56 ! 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); if mark(none) = beginning_of(current_buffer) then message('String not found'); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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) ! SET SEARCH BEGIN is in effect 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; 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'); EDTP$Check_Clear; 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'); EDTP$Check_Clear; return; endif; direction_distance:=1; else if (mark(none) = beginning_of(current_buffer)) then message('String not found'); EDTP$Check_Clear; 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)); 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) ! SET SEARCH BEGIN is in effect THEN position(beginning_of(EDTP$x_search_range)); ELSE ! SET SEARCH END is ine effect position(end_of(EDTP$x_search_range)); 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"); EDTP$Check_Clear; 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) ! SET SEARCH BEGIN is in effect THEN position(beginning_of(EDTP$x_search_range)); ELSE ! SET SEARCH END is ine 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"); EDTP$Check_Clear; EDTP$x_repeat_count := 1; ENDPROCEDURE ! page 59 PROCEDURE EDTP$Set_Tabs LOCAL tab, response, offset, Tab_string,len, len, count, newoffset, beginning, len_1, len_2, tab_pos; ON_ERROR MESSAGE(" Invalid tabs specified. Tabs set to EDT standard."); EDTP$Tabs := ""; EDTP$Expand_Tabs := "NO"; ! ! Check to see if user has the buffer clearing feature ! EDTP$Check_Clear; RETURN 0; ENDON_ERROR MESSAGE("Tab stops have been erased."); EDTP$Expand_tabs := "NO"; EDTP$Expanded_Tabs := ""; EDTP$Tabs := READ_LINE(' Column for a tab stop: '); IF EDTP$Tabs <> "" THEN EDIT(EDTP$Tabs,COLLAPSE,OFF); LOOP tab := READ_LINE(' Column for a tab stop: '); EDIT(Tab,COLLAPSE,OFF); EXITIF tab = ""; EDTP$Tabs := EDTP$Tabs + " " + TAB; ENDLOOP; SET(TAB_STOPS,CURRENT_BUFFER,EDTP$Tabs); response := READ_LINE('Do you want tabs expanded (Y or N)? ',1); CHANGE_CASE(response,UPPER); IF response = 'Y' THEN EDTP$Expand_tabs := "YES"; Count := 1; EDTP$Expanded_tabs := ' '; LOOP EXITIF Count > 200; EDTP$Expanded_tabs := EDTP$Expanded_tabs + ' '; Count := Count + 1; ENDLOOP; Tab_string_len := LENGTH(EDTP$Tabs); Offset := 1; Beginning := 0; ! page 60 LOOP EXITIF Offset > Tab_string_len; IF (SUBSTR(EDTP$Tabs,Offset,1) <> ' ') THEN Beginning := Offset; LOOP EXITIF Offset > Tab_string_len; EXITIF (SUBSTR(EDTP$Tabs,Offset,1) = ' '); Offset := Offset + 1; ENDLOOP; Len := Offset - Beginning; Tab_pos := Substr(EDTP$Tabs,Beginning,len); newoffset := INT(tab_pos); len_1 := newoffset - 1; len_2 := 200 - newoffset; EDTP$Expanded_Tabs := SUBSTR(EDTP$Expanded_tabs,1,len_1) + 'T' + SUBSTR(EDTP$Expanded_tabs,Newoffset+1,len_2); Beginning := 0; ENDIF; Offset := Offset + 1; ENDLOOP; ENDIF; MESSAGE("Tabs are now set in columns " + EDTP$Tabs); MESSAGE(EDTP$Expanded_tabs); ELSE SET(TAB_STOPS,CURRENT_BUFFER,8); MESSAGE("Tabs are now set back to EDT Standard"); ENDIF; ! ! Check to see if user has the buffer clearing feature ! EDTP$Check_Clear; ENDPROCEDURE PROCEDURE EDTP$Show_Tabs LOCAL tab_goal, tab_size; IF EDTP$Tabs <> "" THEN MESSAGE("Tabs are set in columns" + EDTP$Tabs); IF EDTP$Expand_Tabs = "YES" THEN MESSAGE("Tabs are expanded into spaces."); ENDIF; ELSE IF EDTP$x_tabs_set = 1 THEN tab_goal := STR(EDTP$x_tab_goal); tab_size := STR(EDTP$x_tab_size); MESSAGE("Tabs are now set to EDT Standard"); MESSAGE("Tab Size: " + tab_size + " Tab Goal: " + tab_goal); ELSE MESSAGE("Tabs are now set to EDT Standard"); ENDIF; ENDIF; EDTP$Check_Clear; ! Check to see if user has the buffer clearing feature ENDPROCEDURE ! page 61 PROCEDURE EDTP$Tab !tab key LOCAL tab_position, offset, len, Search_str, num_spaces, count; ! ! if not at the beginning of the line just insert a tab ! IF (EDTP$Tabs <> "") AND (EDTP$Expand_Tabs = "YES") THEN Offset := CURRENT_OFFSET + 1; Len := EDTP$x_wrap_position - offset; IF Len < 0 THEN Len := 200 - Offset; ENDIF; Search_str := SUBSTR (EDTP$Expanded_Tabs,offset + 1,len); Num_spaces := INDEX(Search_Str,"T") + 1; IF Num_spaces = 1 THEN COPY_TEXT(" "); ELSE Count := 0; LOOP EXITIF (Count+1) = Num_spaces; COPY_TEXT(" "); Count := Count + 1; ENDLOOP; ENDIF; ELSE IF (EDTP$TABS <> "") OR (CURRENT_OFFSET <> 0) OR (EDTP$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) > EDTP$x_tab_goal); tab_position := tab_position + 8; COPY_TEXT(ASCII(9)); ENDLOOP; IF (((EDTP$x_tab_goal / 8) * 8) <> EDTP$x_tab_goal) THEN LOOP EXITIF ((tab_position + 1) > EDTP$x_tab_goal); tab_position := tab_position + 1; COPY_TEXT(' '); ENDLOOP; ENDIF; ENDIF; ENDIF; ENDPROCEDURE ! page 62 PROCEDURE EDTP$Tab_Adjust LOCAL start_range , end_range , tab_level , adjust_level , original_goal ; ! ! Get the range to adjust ! IF (EDTP$Tabs <> "") THEN MESSAGE(' EDT standard tabs not set. You cannot use Tab Adjust.'); EDTP$Check_Clear; ! Check to see if user has the buffer clearing feature ENDIF; EDTP$select_range; IF (EDTP$x_select_range = 0) THEN message('No select active'); EDTP$Check_Clear; ! Check to see if user has the buffer clearing feature return 0; ENDIF; adjust_level := EDTP$x_repeat_count; EDTP$x_repeat_count := 1; original_goal := EDTP$x_tab_goal; start_range := beginning_of(EDTP$x_select_range); end_range := end_of(EDTP$x_select_Range); EDTP$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') / EDTP$x_tab_size; EDTP$x_Tab_goal := (tab_level + adjust_level) * EDTP$x_tab_size; if (EDTP$x_tab_goal < 0) then EDTP$x_tab_goal := 0 endif; erase_character(-current_offset); EDTP$tab; endif; move_vertical(1); move_horizontal(-current_offset); endloop; EDTP$x_tab_goal := original_goal; ENDPROCEDURE ! page 63 PROCEDURE EDTP$Set_beginning_Tabs ! ! Routine to set up tabs after EDTP$User_Commands has been ! executed. If the user has set up special tabs this procedure ! sets up to use those tabs. ! LOCAL tab, response, offset, Tab_string,len, len, count, newoffset, beginning, len_1, len_2, tab_pos; ON_ERROR MESSAGE(" Invalid tabs specified. Tabs set to EDT standard."); EDTP$Tabs := ""; EDTP$Expand_Tabs := "NO"; EDTP$Check_Clear; RETURN 0; ENDON_ERROR IF EDTP$Tabs <> "" THEN SET(TAB_STOPS,CURRENT_BUFFER,EDTP$Tabs); IF EDTP$Expand_Tabs = 'YES' THEN Count := 1; EDTP$Expanded_tabs := ' '; LOOP EXITIF Count > 200; EDTP$Expanded_tabs := EDTP$Expanded_tabs + ' '; Count := Count + 1; ENDLOOP; Tab_string_len := LENGTH(EDTP$Tabs); Offset := 1; Beginning := 0; LOOP EXITIF Offset > Tab_string_len; IF (SUBSTR(EDTP$Tabs,Offset,1) <> ' ') THEN IF (Beginning = 0) THEN Beginning := Offset; ELSE LOOP EXITIF Offset > Tab_string_len; EXITIF (SUBSTR(EDTP$Tabs,Offset,1) = ' '); Offset := Offset + 1; ENDLOOP; ! page 64 Len := Offset - Beginning; Tab_pos := Substr(EDTP$Tabs,Beginning,len); newoffset := INT(tab_pos); len_1 := newoffset - 1; len_2 := 200 - newoffset; EDTP$Expanded_Tabs := SUBSTR(EDTP$Expanded_tabs,1,len_1) + 'T' + SUBSTR(EDTP$Expanded_tabs,Newoffset+1,len_2); Beginning := 0; ENDIF; Offset := Offset + 1; ENDIF; ENDLOOP; ENDIF; MESSAGE("Tabs are set in columns " + EDTP$Tabs); MESSAGE(EDTP$Expanded_tabs); ELSE SET(TAB_STOPS,CURRENT_BUFFER,8); MESSAGE("Tabs are set to EDT Standard"); ENDIF; EDTP$Check_Clear; ENDPROCEDURE ! page 65 PROCEDURE EDTP$User_commands ! ! Routine to read in and execute command files that the user ! has set up to customize tpu for him/her. The file ! SYS$LOGIN:ACCOUNT_EDTPINI.TPU is a file that will always be ! executed, no matter what direcotry the user is in. The file ! EDTPINI.TPU will only 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 ! ! Check and see if file SYS$LOGIN:ACCOUNT_EDTPINI.TPU exists ! and if so, then read it in and execute the commands. ! File := FILE_SEARCH('SYS$LOGIN:ACCOUNT_EDTPINI.TPU'); IF File <> "" THEN Buffer_ptr := CREATE_BUFFER ('User_Commands',File); POSITION (BEGINNING_OF(Buffer_Ptr)); commands := compile (buffer_ptr); ! Compile commands EXECUTE (commands); ! Execute commands ENDIF; ! ! Check and see if file EDTPINI.TPU exists and if so, then read ! it in and execute the commands. ! 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; commands := compile (buffer_ptr); EXECUTE (commands); ENDIF; POSITION (BEGINNING_OF(main_buffer)); ! Reset to main buffer ! ! If the User_Commands buffer was created, then delete hte buffer. ! IF (Buffer_ptr <> 0) THEN DELETE (Buffer_ptr); ENDIF; ENDPROCEDURE ! page 66 PROCEDURE EDTP$get_out ! ! 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. ! ! 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 + D and give"); MESSAGE (" a null command to 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(MAIN_WINDOW,0,-3); RETURN ENDON_ERROR; ! ! Set the "Writing File" message to apeear at one second intervals ! SET (TIMER, ON, "Writing File"); WRITE_FILE(MAIN_BUFFER); ! Write file SET (TIMER, OFF, "Writing File"); ! Remove message EXIT; 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(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(MAIN_BUFFER); ! or using default name. ENDIF; SET (TIMER, OFF, "Writing File"); EXIT; ENDPROCEDURE ! page 68 PROCEDURE EDTP$Check_Clear LOCAL Ret; IF (EDTP$Clear_Message = "YES") THEN Ret := READ_LINE('Press RETURN to continue'); ERASE(MESSAGE_BUFFER); ENDIF; ENDPROCEDURE PROCEDURE EDTP$INSERT_RULER LOCAL short_Ruler, long_ruler_first, long_ruler_last, long_ruler, current_width, Start_Mark; start_mark := MARK(NONE); ! Save current location temp_offset := CURRENT_OFFSET; ! Find distance to beinning of line IF temp_offset <> 0 THEN MOVE_HORIZONTAL(-temp_offset); ! Move to beginning of line ENDIF; SPLIT_LINE; ! Split the line (open new line) MOVE_HORIZONTAL(-1); ! Move to new line ! ! Find out the current window width and insert in the proper size ruler ! current_width := GET_INFO(CURRENT_WINDOW,"width"); IF (current_width < 81) then short_ruler := "....v....1....v....2....v....3....v....4....v....5....v....6....v....7....v...."; COPY_TEXT(short_ruler); ELSE long_ruler_first := "....v....1....v....2....v....3....v....4....v....5....v....6....v."; long_ruler_last := "...7....v....8....v....9....v...10....v...11....v...12....v...."; long_ruler := long_ruler_first + long_ruler_last; COPY_TEXT(long_ruler) ENDIF; POSITION (start_mark); ! Move back to original position ENDPROCEDURE ! page 69 PROCEDURE EDTP$Insert_DCL_Comment LOCAL DCL_Comment, Start_Mark; start_mark := MARK(NONE); ! Save Current location temp_offset := CURRENT_OFFSET; ! Find offset to begining of line IF temp_offset <> 0 THEN MOVE_HORIZONTAL(-temp_offset); ! Move to beginning of line ENDIF; SPLIT_LINE; ! Open new line MOVE_HORIZONTAL(-1); ! Move to new line DCL_Comment:= "$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"; COPY_TEXT(DCL_Comment); ! Enter comment line POSITION (start_mark); ! Return to original position ENDPROCEDURE PROCEDURE EDTP$Insert_FORT_Comment LOCAL FORT_Comment, temp_offset, Start_Mark; start_mark := MARK(NONE); ! Save original location temp_offset := CURRENT_OFFSET; ! Find offset to begining of line IF temp_offset <> 0 THEN MOVE_HORIZONTAL(-temp_offset); ! Move to beginning of line ENDIF; SPLIT_LINE; ! Open new line MOVE_HORIZONTAL(-1); ! Move to new line FORT_Comment:= "C************************************************************************"; COPY_TEXT(FORT_Comment); ! Insert comment line POSITION (start_mark); ! return to original position 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 ! EDTP$Check_Clear; 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); IF EDTP$Tabs <> "" THEN SET (TAB_STOPS,buffer_ptr,EDTP$Tabs); ENDIF; 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; EDTP$Set_Status_line(CURRENT_WINDOW); ! buffer_1 := GET_INFO(buffer_ptr,"NAME"); ! status_1 := "BUFFER: " + buffer_1 + " FILE:" + file_1; ! IF Buffer_1 <> "MAIN" THEN ! SET (STATUS_LINE,CURRENT_WINDOW,REVERSE,status_1); ! ELSE ! SET (STATUS_LINE,CURRENT_WINDOW,NONE,""); ! ENDIF; 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; EDTP$Set_Status_line(CURRENT_WINDOW); ! buffer_1 := GET_INFO(buffer_ptr,"NAME"); ! status_1 := "BUFFER: " + buffer_1 + " FILE:" + file_1; ! IF Buffer_1 <> "MAIN" THEN ! SET (STATUS_LINE,CURRENT_WINDOW,REVERSE,status_1); ! ELSE ! SET (STATUS_LINE,CURRENT_WINDOW,NONE,""); ! ENDIF; 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; !SET (STATUS_LINE,CURRENT_WINDOW,NONE,""); ! Make sure status line is blank MAP(CURRENT_WINDOW,buffer_ptr); EDTP$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 ! EDTP$Check_Clear; 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 ! EDTP$Check_Clear; 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 ! EDTP$Check_Clear; RETURN 0; ELSE ERASE(buffer_ptr); RETURN 1; ENDIF; ENDPROCEDURE ! page 77 PROCEDURE EDTP$tab_jump ! ! 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. ! ! one might sensibly choose the command cursor_horizontal ! but that doesn't go from one line to the next and can be hanging ! out in space beyond the end of the line. IF current_direction = forward THEN MOVE_HORIZONTAL(+8) ELSE MOVE_HORIZONTAL(-8) ENDIF; ENDPROCEDURE PROCEDURE EDTP$swap_2_characters ! ! 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 first; MOVE_HORIZONTAL(+1); first := ERASE_CHARACTER(+1); MOVE_HORIZONTAL(-1); COPY_TEXT (first); MOVE_HORIZONTAL(-1); 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.'); EDTP$Check_Clear; 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'); EDTP$Check_Clear; 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 82 PROCEDURE EDTP$top_parag ! ! 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 parag_top_range; MOVE_HORIZONTAL(-2); parag_top_RANGE := SEARCH(EDTP$parag_delim,REVERSE,EXACT); IF parag_top_range = 0 THEN POSITION (BEGINNING_OF(CURRENT_BUFFER)); ELSE POSITION(parag_top_range); MOVE_VERTICAL(+1); ENDIF; ENDPROCEDURE PROCEDURE EDTP$end_parag ! ! 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 parag_end_range; MOVE_HORIZONTAL(+1); parag_end_RANGE := SEARCH(EDTP$parag_delim,FORWARD,EXACT); IF parag_end_range = 0 THEN POSITION (END_OF(CURRENT_BUFFER)); ELSE POSITION(parag_end_range); MOVE_VERTICAL(+1); ENDIF; ENDPROCEDURE ! page 83 PROCEDURE EDTP$end_sent ! ! 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 space, space_range, non_space, non_space_range, sent_end_range; sent_end_range := SEARCH(EDTP$sent_delim,FORWARD,EXACT); IF sent_end_range = 0 THEN RETURN; ENDIF; POSITION(sent_end_range); space := ''&(' ' | LINE_END); space_range := SEARCH(space,FORWARD,EXACT); IF space_range = 0 THEN RETURN; ENDIF; POSITION(space_range); non_space := ''&(LINE_BEGIN | NOTANY (' ')); non_space_range := search(non_space,forward,exact); IF non_space_range = 0 THEN RETURN; ENDIF; POSITION(non_space_range); ENDPROCEDURE ! page 84 PROCEDURE EDTP$top_sent ! ! 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. ! ! ! move backward to beginning of sentence ! LOCAL non_space_range, non_space, space, space_range, start_mark, next_mark, this_mark, sent_top_range; start_mark := MARK(NONE); MOVE_HORIZONTAL(-5); sent_top_RANGE := SEARCH(EDTP$sent_delim,REVERSE); IF sent_top_range = 0 THEN POSITION(start_mark); RETURN; ENDIF; POSITION(BEGINNING_OF(sent_top_range)); space := '' & (' ' | LINE_END); space_range := SEARCH(space,FORWARD); IF space_range = 0 THEN RETURN; ENDIF; POSITION(space_range); non_space_range := SEARCH(''&(LINE_BEGIN | NOTANY(' ')),FORWARD); IF non_space_range = 0 THEN RETURN; ENDIF; POSITION(non_space_range); ENDPROCEDURE ! page 85 PROCEDURE EDTP$fill_parag ! ! 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 begin_mark, top, parag_end_range; begin_mark := MARK(NONE); SET(SCREEN_UPDATE,OFF); EDTP$top_parag; MOVE_HORIZONTAL(+1); top := MARK(NONE); parag_end_RANGE := SEARCH(EDTP$parag_delim,FORWARD,EXACT); IF parag_end_range = 0 THEN parag_end_range := CREATE_RANGE(top,END_OF(CURRENT_BUFFER),NONE); ELSE POSITION(END_OF(parag_end_range)); MOVE_HORIZONTAL(-1); parag_end_range := CREATE_RANGE(top,MARK(NONE),NONE); ENDIF; FILL(parag_end_range,EDTP$x_word,1,EDTP$x_wrap_position); POSITION (begin_mark); SET(SCREEN_UPDATE,ON); 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 ! EDTP$Check_Clear; 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 88 PROCEDURE EDTP$Set_parameters IF (EDTP$Parameters = 'WP') 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'; EDTP$x_wrap_position := EDTP$Wrap_Setting_1; EDTP$Parameters := 'Prog'; 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$x_wrap_position := EDTP$Wrap_Setting_2; EDTP$Parameters := 'WP'; EDTP$word_delim := 'text'; ENDIF; ENDPROCEDURE PROCEDURE EDTP$find_line ! ! 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 line_no; POSITION(BEGINNING_OF(CURRENT_BUFFER)); line_no := READ_LINE('Enter line number to find: '); IF line_no <> "" THEN MOVE_VERTICAL ( INT (line_no) - 1); ENDIF ENDPROCEDURE ! page 89 PROCEDURE EDTP$Make_windows ! ! 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. ! ! Window control: single- or double-window editing for use with ! multi-buffer commands. ! ! PF1 + CTRL/W will query the number of windows, establish and map ! them, and re-define PF1 + B and PF1 + M suitably. ! ! LOCAL window_count, buffer_name_2, window_top, delta_top, window_bottom, make_file_name_2, make_buf_var, delta_bottom, file_name_2; ! ! global variables are EDTP$window_nam_1 the main window ! EDTP$window_nam_2 second ! EDTP$buffer_nam_1 the main buffer ! EDTP$buffer_nam_2 second ! window_count := READ_LINE("Enter number of windows (1 or 2): ",1); IF window_count = "1" THEN ! here if normal usage ! ! restore standard key definitions; ! ensure that there is one mapped window, with standard size, to main ! buffer. ! EDTP$window_size := 21; ! DEFINE_KEY ('EDTP$Set_buffer',KEY_NAME('B',SHIFT_KEY),"Edit a buffer."); ! DEFINE_KEY ('EDTP$main_buf',KEY_NAME('M',SHIFT_KEY), ! "Return to editing the main buffer."); ! ! EDTP$window_nam_1 := CURRENT_WINDOW; SET (SCROLLING,CURRENT_WINDOW,ON,7,7,0); window_top := GET_INFO(CURRENT_WINDOW,"VISIBLE_TOP"); IF window_top <> 1 THEN delta_top := 1 - window_top; ADJUST_WINDOW(CURRENT_WINDOW,delta_top,0); ENDIF; window_bottom := GET_INFO(CURRENT_WINDOW,"VISIBLE_BOTTOM"); ! page 90 IF window_bottom <> 21 THEN delta_bottom := 21 - window_bottom; ADJUST_WINDOW(CURRENT_WINDOW,0,delta_bottom); ENDIF; buffer_1 := GET_INFO(CURRENT_BUFFER,"NAME"); IF (buffer_1 <> "MAIN") THEN file_1 := GET_INFO(CURRENT_BUFFER,"FILE_NAME"); IF file_1 = "" THEN file_1 := GET_INFO(CURRENT_BUFFER,"OUTPUT_FILE"); IF file_1 = 0 THEN file_1 := ""; ENDIF; ENDIF; status_1 := "BUFFER:" + buffer_1 + " FILE:" + file_1; EDTP$Set_Status_line(CURRENT_WINDOW); ! SET (STATUS_LINE,CURRENT_WINDOW,REVERSE,status_1); ELSE EDTP$Set_Status_line(CURRENT_WINDOW); ! SET (STATUS_LINE,CURRENT_WINDOW,NONE,""); ENDIF; EDTP$Windows := "OFF"; REFRESH; RETURN 1; ELSE IF window_count = "2" THEN ! here for dual-window usage ! ! ensure that there are two mapped windows, with half size, upper to ! main buffer, and lower to second buffer, each w/ status line. ! ! first, clean up the original file's buffer ! EDTP$window_size := 10; EDTP$window_nam_1 := CURRENT_WINDOW; window_top := GET_INFO(CURRENT_WINDOW,"VISIBLE_TOP"); IF window_top <> 1 THEN delta_top := 1 - window_top; ADJUST_WINDOW(CURRENT_WINDOW,delta_top,0); ENDIF; window_bottom := GET_INFO(CURRENT_WINDOW,"VISIBLE_BOTTOM"); IF window_bottom <> 11 THEN delta_bottom := 11 - window_bottom; ADJUST_WINDOW(CURRENT_WINDOW,0,delta_bottom); ENDIF; file_1 := GET_INFO(CURRENT_BUFFER,"FILE_NAME"); IF file_1 = "" THEN file_1 := GET_INFO(CURRENT_BUFFER,"OUTPUT_FILE"); IF file_1 = 0 THEN file_1 := ""; ENDIF; ENDIF; buffer_1 := GET_INFO(CURRENT_BUFFER,"NAME"); status_1 := "BUFFER:" + buffer_1 + " FILE:" + file_1; EDTP$Set_Status_line(CURRENT_WINDOW); ! SET (STATUS_LINE,CURRENT_WINDOW,REVERSE,status_1); ! page 91 ! now establish second window, buffer, and file ! buffer_name := READ_LINE("Enter name of second buffer: "); IF (buffer_name = EDTP$x_empty) THEN MESSAGE('No buffer specified'); EDTP$Check_Clear; ! Check to see if user has the buffer clearing feature RETURN 0; ENDIF; ! IF it exists just map to it. EDTP$buffer_nam_2 := buffer_name; buffer_ptr := EDTP$find_buffer(buffer_name); IF buffer_ptr = 0 THEN file_name_2 := READ_LINE("Enter file for second buffer: "); EDTP$buffer_nam_2 := CREATE_BUFFER(buffer_name,file_name_2); IF file_name_2 <> "" THEN SET (OUTPUT_FILE,EDTP$Buffer_nam_2,file_name_2); ENDIF; ! Now get the pointer back, we know it is the last buffer in the list buffer_ptr := GET_INFO (BUFFERS,'LAST'); file_write := READ_LINE ("Write the contents of this buffer to a file upon exit [Y/N]? "); 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; SET(EOB_TEXT, buffer_ptr, '[End of '+buffer_name+']'); ENDIF; ! ! now we have the buffer and file set up, it is second window time ! EDTP$window_nam_2 := CREATE_WINDOW(12,11,ON); MAP(EDTP$window_nam_2,buffer_ptr); EDTP$Set_Status_line(EDTP$window_nam_2); ! DEFINE_KEY ('POSITION(EDTP$window_nam_2)',KEY_NAME('B',SHIFT_KEY), ! "Edit buffer two."); ! DEFINE_KEY ('POSITION(EDTP$window_nam_1)',KEY_NAME('M',SHIFT_KEY), ! "Edit buffer one."); SET (SCROLLING,EDTP$window_nam_1,ON,3,3,0); SET (SCROLLING,EDTP$window_nam_2,ON,3,3,0); EDTP$Windows := "ON"; RETURN 1; ELSE ! here for improper response MESSAGE('Illegal, you must respond with 1 or 2.'); ! ! Check to see if user has the buffer clearing feature ! EDTP$Check_Clear; RETURN 0; ENDIF; ENDIF; ENDPROCEDURE ! page 92 PROCEDURE EDTP$Change_Windows ! ! Routine to change between windows ! IF EDTP$Windows = "ON" THEN IF EDTP$window_nam_2 = CURRENT_WINDOW THEN POSITION(EDTP$Window_nam_1); ELSE POSITION(EDTP$Window_nam_2); ENDIF; EDTP$Set_Status_Line(CURRENT_WINDOW); ELSE MESSAGE('Dual windows not in use. Cannot switch windows.'); ! ! Check to see if user has the buffer clearing feature ! EDTP$Check_Clear; ENDIF; ENDPROCEDURE PROCEDURE EDTP$include_file ! ! 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. ! ! include a file in the current buffer ! LOCAL filename; filename := READ_LINE("Enter name of file to include: "); IF Filename = "" THEN Return 0; ENDIF; READ_FILE(filename); ENDPROCEDURE PROCEDURE EDTP$overstrike ! ! 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. ! ! ! swaps between overstrike and insert modes ! IF (EDTP$entry_mode = 'insert') THEN SET (OVERSTRIKE,CURRENT_BUFFER); EDTP$entry_mode := 'overstrike'; ELSE SET (INSERT,CURRENT_BUFFER); EDTP$entry_mode := 'insert'; ENDIF; EDTP$Set_Status_Line(CURRENT_WINDOW); ENDPROCEDURE PROCEDURE EDTP$Set_Forward ! ! Sets the buffer direction forward ! SET(FORWARD,CURRENT_BUFFER); ! EDTP$Set_Status_Line(CURRENT_WINDOW); ENDPROCEDURE; PROCEDURE EDTP$Set_Reverse ! ! Sets the buffer direction forward ! SET(REVERSE,CURRENT_BUFFER); ! EDTP$Set_Status_Line(CURRENT_WINDOW); ENDPROCEDURE; ! page 93 PROCEDURE EDTP$Change_Width ! ! swaps between normal and widescreen for single window screens ! IF (EDTP$Width_Size = 'WIDE') THEN SET (WIDTH,CURRENT_WINDOW,80); EDTP$Width_Size := 'NORMAL'; ELSE SET (WIDTH,CURRENT_WINDOW,132); EDTP$Width_Size := 'WIDE'; 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$Set_Wrap ! ! sets EDTP wrap to 79 chars ! IF EDTP$x_wrap_position = EDTP$Wrap_Setting_1 THEN EDTP$x_wrap_position := EDTP$Wrap_Setting_2; ELSE EDTP$x_wrap_position := EDTP$Wrap_Setting_1; 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 ! EDTP$Check_Clear; 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 ! EDTP$Check_Clear; 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$Check_Clear; 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 ! EDTP$Check_Clear; RETURN; ENDIF; IF (BEGINNING_OF(buffer_ptr) <> END_OF(buffer_ptr)) THEN COPY_TEXT(buffer_ptr); APPEND_LINE; ENDIF; ENDPROCEDURE ! page 98 PROCEDURE EDTP$FORTRAN_HELP LOCAL old_buffer, old_window; old_buffer := CURRENT_BUFFER; old_window := CURRENT_WINDOW; SET (STATUS_LINE, INFO_WINDOW, REVERSE, 'Press CTRL/Z to leave prompts and return to editing'); MAP (INFO_WINDOW, help_buffer); HELP_TEXT ('DUA1:[CODE.EDT]FORHELP',READ_LINE('Fortran Topic: '), ON, help_buffer); SET (STATUS_LINE,INFO_WINDOW,NONE,''); UNMAP (INFO_WINDOW); ERASE(message_buffer); ENDPROCEDURE PROCEDURE EDTP$DCL_HELP LOCAL old_buffer, old_window; old_buffer := CURRENT_BUFFER; old_window := CURRENT_WINDOW; SET (STATUS_LINE,INFO_WINDOW,REVERSE, 'Press CTRL/Z to leave prompts and return to editing'); MAP (INFO_WINDOW, help_buffer); HELP_TEXT ('HELPLIB',READ_LINE('DCL Topic: '), ON, help_buffer); SET (STATUS_LINE,INFO_WINDOW,NONE,''); UNMAP (INFO_WINDOW); ERASE(message_buffer); ENDPROCEDURE PROCEDURE EDTP$PL1_HELP LOCAL old_buffer, old_window; old_buffer := CURRENT_BUFFER; old_window := CURRENT_WINDOW; SET (STATUS_LINE,INFO_WINDOW,REVERSE, 'Press CTRL/Z to leave prompts return to editing'); MAP (INFO_WINDOW, help_buffer); HELP_TEXT ('DUA1:[CODE.EDT]PL1HELP',READ_LINE('PL1 Topic: '), ON, help_buffer); SET (STATUS_LINE,INFO_WINDOW,NONE,''); UNMAP (INFO_WINDOW); ERASE(message_buffer); ENDPROCEDURE PROCEDURE EDTP$EDT_HELP LOCAL old_buffer, old_window; old_buffer := CURRENT_BUFFER; old_window := CURRENT_WINDOW; SET (STATUS_LINE,INFO_WINDOW,REVERSE, 'Press CTRL/Z to leave prompts return to editing'); MAP (INFO_WINDOW, help_buffer); HELP_TEXT ('DUA1:[CODE.EDT]EDTHELP',READ_LINE('EDTP Topic: '), ON, help_buffer); SET (STATUS_LINE,INFO_WINDOW,NONE,''); UNMAP (INFO_WINDOW); ERASE(message_buffer); 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; EDTP$Set_Status_line(CURRENT_WINDOW); ! SET (STATUS_LINE,CURRENT_WINDOW, NONE, ""); 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, eob, buf; buf := CURRENT_BUFFER; 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 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"); EDTP$Check_Clear; ENDPROCEDURE PROCEDURE EDTP$STOP_LEARN_X EDTP$Learn_1 := LEARN_END; DEFINE_KEY(EDTP$Learn_1,EDTP$Learn_Key); MESSAGE("LEARN Completed"); EDTP$Check_Clear; 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 to wrap the word to the next line. Bound to space key when ! a SET WRAP is done. ! PROCEDURE EDTP$wrap_word ! space key (wrap word) LOCAL word_size , trash_space ; if EDTP$x_wrap_position = 0 then unDEFINE_KEY(key_name(' ')); ! We shouldn't be calling this anymore 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 ! page 106 PROCEDURE EDTP$Set_Status_line(Which_Window) LOCAL Which_Buffer, Mode, file, Direc, Buffer_name; Which_Buffer:= CURRENT_BUFFER; IF (Which_Buffer = 0) THEN RETURN; ENDIF; IF (GET_INFO(Which_Buffer,"MODE") = INSERT) THEN MODE := 'Insert '; ELSE MODE := 'Overstrike'; ENDIF; IF (GET_INFO(Which_Buffer,"DIRECTION") = FORWARD) THEN DIREC := 'Forward'; ELSE DIREC := 'Reverse'; ENDIF; BUFFER_NAME := GET_INFO(Which_BUFFER,'NAME'); file := GET_INFO(which_buffer,'FILE_NAME'); IF file = "" THEN file := GET_INFO(Which_buffer,'FILE_NAME'); ENDIF; IF (LENGTH(Buffer_name)>9) THEN Buffer_name := '<' + SUBSTR(Buffer_Name,1,9) + '>' ELSE Buffer_name := '<' + Buffer_Name + '>' + SUBSTR(' ',1, 9 - LENGTH(buffer_name)); ENDIF; IF (LENGTH(File)>37) THEN File := 'File: ' + SUBSTR(File,1,37) ELSE File := 'File: ' + File + SUBSTR(' ',1, 37 - LENGTH(File)); ENDIF; SET(STATUS_LINE,Which_Window,REVERSE,Buffer_Name + " " + File + " " + Mode + " " + Direc); UPDATE(which_window); ENDPROCEDURE; !+ ! Procedure to calculate the character position column !- PROCEDURE EDTP$Calc_position LOCAL Shift_cols; Shift_Cols := GET_INFO(CURRENT_WINDOW,"SHIFT_AMOUNT"); EDTP$Calc_position := GET_INFO(CURRENT_BUFFER,"OFFSET_COLUMN") + Shift_cols; ENDPROCEDURE ! page 107 PROCEDURE EDTP$Column_Cut LOCAL temp_position, begin_range, end_range, end_column, start_column, cur_offset, next_offset, temp, buffer_ptr, new_buffer, length_str, column1, column2, Col_text, save_position; !+ ! Check for no select active !- EDTP$select_range; if EDTP$x_select_range = 0 then message("No Select Active"); EDTP$Check_Clear; EDTP$x_repeat_count := 1; RETURN; endif; temp_position := MARK(NONE); new_buffer:= READ_LINE("Buffer to cut columns 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); !+ ! Find the beginning of the range and the end fo the range !- Begin_range := BEGINNING_OF(EDTP$x_Select_Range); End_Range := END_OF(EDTP$x_Select_Range); !+ ! Calculate the begining column and the ending column. !- POSITION (End_Range); end_column := EDTP$Calc_position; POSITION(Begin_Range); start_column := EDTP$Calc_position; ! page 108 !+ ! Step through the selected lines, cutting the text to the specified buffer. !- Length_Str := End_Column - Start_Column; MOVE_HORIZONTAL(-CURRENT_OFFSET); LOOP EXITIF MARK(NONE) > end_range; !+ ! Move to the starting column position, track the column by moving one ! character at a time and then checking the position. This allows for ! tab characters in the line. If a tab expands through the column ! boundries, move back one position to pick the tab on the left. ! Check to see if the chracter position is at the end of the line by ! looking at the next character position. If att the end of the line ! move back one position as not to cut the end-of-line character. !- LOOP EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER); MOVE_HORIZONTAL(1); Cur_Offset := EDTP$Calc_Position; EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER); MOVE_HORIZONTAL(1); Next_Offset := EDTP$Calc_Position; MOVE_HORIZONTAL(-1); IF Next_Offset < Cur_Offset THEN MOVE_HORIZONTAL(-1); EXITIF 1=1; ENDIF; EXITIF Cur_offset = Start_Column; IF Cur_Offset > Start_Column THEN MOVE_HORIZONTAL(-1); EXITIF 1=1; ENDIF; ENDLOOP; !+ ! Mark the left side boundry !- Column1 := MARK(NONE); LOOP EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER); MOVE_HORIZONTAL(1); Cur_Offset := EDTP$Calc_Position; EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER); MOVE_HORIZONTAL(1); Next_Offset := EDTP$Calc_Position; MOVE_HORIZONTAL(-1); IF Next_Offset < Cur_Offset THEN MOVE_HORIZONTAL(-1); EXITIF 1=1; ENDIF; EXITIF Cur_offset = End_Column; IF Cur_Offset > End_Column THEN MOVE_HORIZONTAL(-1); EXITIF 1=1; ENDIF; ENDLOOP; ! page 109 !+ ! Mark the right side boundry !- Column2 := MARK(NONE); !+ ! Check to see if the range will have any characters to be cut. If not, ! then don't cut anything, just leave an empty line in the paste buffer. !- IF (EDTP$Calc_Position < Start_Column) THEN save_position := MARK(NONE); POSITION(Buffer_Ptr); SPLIT_LINE; POSITION(save_position); ELSE !+ ! Create the range for the text we're cutting and move it to the new buffer !- Col_Text := CREATE_RANGE(Column1,Column2,NONE); save_position := MARK(NONE); POSITION(Buffer_Ptr); MOVE_TEXT(Col_Text); MOVE_HORIZONTAL(1); !+ ! Reposition to the other buffer !- POSITION(save_position); UPDATE(CURRENT_WINDOW); ENDIF; !+ ! Move to the next line !- MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1); ENDLOOP; !+ ! Position to the previous position and reset EDTP$x_Select_Range. !- POSITION(temp_position); EDTP$x_Select_range := 0; ENDPROCEDURE; ! page 110 PROCEDURE EDTP$Column_Paste !+ ! This procedure pastes the lines in the specified buffer back starting ! in a specified column using the current position in the current buffer ! as the upper left corner. !- LOCAL new_buffer, text_buffer, cur_offset, next_offset, buffer_ptr, save_position, start_column, paste_line, save_buffer; Text_buffer:= READ_LINE("Buffer to paste columns from: "); CHANGE_CASE(Text_buffer,UPPER); buffer_ptr := GET_INFO(BUFFERS,'FIRST'); LOOP EXITIF buffer_ptr = 0; EXITIF text_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 ! EDTP$Check_Clear; RETURN; ENDIF; save_buffer := CURRENT_BUFFER; save_position := MARK(NONE); start_column := EDTP$Calc_Position; POSITION(BEGINNING_OF(buffer_ptr)); !+ ! Loop through lines in the specified buffer, putting them at the ! appropriate offset in the current buffer. !- LOOP EXITIF MARK(NONE) = END_OF(buffer_ptr); !+ ! Get the current line of the paste buffer. !- paste_line := CURRENT_LINE; MOVE_VERTICAL(1); POSITION(save_buffer); MOVE_HORIZONTAL(-CURRENT_OFFSET); ! page 111 !+ ! Move to the starting column position, track the column by moving one ! character at a time and then checking the position. This allows for ! tab characters in the line. If a tab expands through the column ! boundries, move back one position to pick the tab on the left. !- LOOP EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER); MOVE_HORIZONTAL(1); Cur_Offset := EDTP$Calc_Position; EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER); MOVE_HORIZONTAL(1); Next_Offset := EDTP$Calc_Position; MOVE_HORIZONTAL(-1); IF Next_Offset < Cur_Offset THEN EXITIF 1=1; ENDIF; EXITIF Cur_offset = Start_Column; IF Cur_Offset > Start_Column THEN MOVE_HORIZONTAL(-1); EXITIF 1=1; ENDIF; ENDLOOP; COPY_TEXT(paste_line); MOVE_VERTICAL(1); POSITION(buffer_ptr); UPDATE(CURRENT_WINDOW); ENDLOOP; !+ ! Position to start of pasted text. !- POSITION(save_position); ENDPROCEDURE ! page 112 Procedure EDTP$Column_Cut_or_Paste LOCAL Selection; Selection := READ_LINE("C(ut) or P(aste) :",1); CHANGE_CASE(Selection,UPPER); IF (Selection = "C") THEN EDTP$Column_Cut; RETURN; ELSE IF (Selection = "P") THEN EDTP$Column_Paste; RETURN; ELSE MESSAGE(" Invalid Option for column cut or paste."); EDTP$Check_Clear; RETURN; 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 ; ! ! 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('EDTP$motion(-1)',UP,"Up_arrow"); ! up DEFINE_KEY('EDTP$motion(+1)',DOWN,"Down_arrow"); ! down DEFINE_KEY ('MOVE_VERTICAL(-(EDTP$window_size))', KEY_NAME(UP,SHIFT_KEY),"Move_screen_up"); ! gold up DEFINE_KEY ('MOVE_VERTICAL(+(EDTP$window_size))', KEY_NAME(DOWN,SHIFT_KEY),"Move_screen_down"); ! gold down ! ! Editing keypad keys ! DEFINE_KEY('EDTP$search',E1,"find"); ! find DEFINE_KEY('EDTP$paste',E2,"paste"); ! insert here DEFINE_KEY('EDTP$cut',E3,"cut"); ! remove DEFINE_KEY("EDTP$select",E4,"select"); ! select DEFINE_KEY('EDTP$section(reverse)',E5,"sect"); ! prev screen DEFINE_KEY('EDTP$section(forward)',E6,"sect"); ! next screen ! ! Function keys ! DEFINE_KEY("EDTP$keypad_help",help,"keypad_diagram"); ! help diagram DEFINE_KEY("EDTP$help(EDTP$x_empty)", key_name(help,shift_key),"vaxtpu_help"); ! help on topic ! ! keypad keys ! !first row ! DEFINE_KEY("EDTP$keypad_help",pf2,"keypad_diagram"); ! help diagram DEFINE_KEY("EDTP$help(EDTP$x_empty)", key_name(pf2,shift_key),"vaxtpu_help"); ! help on topic DEFINE_KEY('EDTP$search_next',PF3,"fndnxt"); ! find next DEFINE_KEY('EDTP$search', key_name(PF3,shift_key),"find"); ! find DEFINE_KEY('EDTP$delete_line',pf4,"del_l"); ! delete line DEFINE_KEY('EDTP$undelete_line', key_name(pf4,shift_key),"und_l"); ! undelete line ! page 114 ! second row ! DEFINE_KEY('EDTP$page',kp7,"page"); ! page DEFINE_KEY ('EDTP$Line_mode(EDTP$Single_line)', KEY_NAME(KP7,SHIFT_KEY),"EDT_Command"); ! EDTP line Command DEFINE_KEY('EDTP$section(current_direction)', Kp8,"sect"); ! section DEFINE_KEY('EDTP$fill', key_name(kp8,shift_key),"fill"); ! fill DEFINE_KEY('EDTP$append',kp9,"append"); ! append DEFINE_KEY('EDTP$replace', key_name(kp9,shift_key),"replace"); ! replace DEFINE_KEY('EDTP$delete_end_word',minus,"del_w") ; ! delete word DEFINE_KEY('EDTP$undelete_word', key_name(minus,shift_key),"und_w"); ! undelete word ! !third row ! DEFINE_KEY('EDTP$Set_Forward',Kp4,"advance"); ! advance DEFINE_KEY('position(end_of(current_buffer))', key_name(kp4,shift_key),"bottom"); ! bottom DEFINE_KEY('EDTP$Set_Reverse',Kp5,"backup"); ! backup DEFINE_KEY('position(beginning_of(current_buffer))' ,key_name(kp5,shift_key),"top"); ! top DEFINE_KEY("EDTP$cut",kp6,"cut"); ! Cut DEFINE_KEY("EDTP$paste",key_name(kp6,shift_key),"paste"); ! Paste DEFINE_KEY('EDTP$delete_char',comma,"del_c"); ! delete chr DEFINE_KEY('EDTP$undelete_char', key_name(comma,shift_key),"und_c"); ! undelete character ! !fourth row ! DEFINE_KEY('EDTP$move_word_f',kp1,"word_forward"); ! move word forward DEFINE_KEY('EDTP$change_case', key_name(kp1,shift_key),"chngcase"); ! change case DEFINE_KEY('EDTP$end_of_line',kp2,"eol"); ! end of line DEFINE_KEY('EDTP$delete_to_eol', key_name(Kp2,shift_key),"del_eol"); ! delete to end of line DEFINE_KEY('EDTP$move_word_r',kp3,"word_reverse"); ! move word DEFINE_KEY( 'copy_text(ascii(int(read_line("SPECINS : "))))', key_name(kp3,shift_key),"specins"); ! special insert ! !fifth row ! DEFINE_KEY('EDTP$next_prev_line',kp0,"by_line"); ! move to beg of line DEFINE_KEY('split_line;move_horizontal(-1)', key_name(kp0,shift_key),"open_line"); ! open line DEFINE_KEY("EDTP$select",period,"select"); ! Select DEFINE_KEY("EDTP$reset", key_name(period,shift_key),"reset"); ! RESET DEFINE_KEY('EDTP$substitute', key_name(enter,shift_key),"subs"); ! substitute ! page 115 ! ! control keys ! DEFINE_KEY('EDTP$wrap_word',key_name(' ')); DEFINE_KEY('EDTP$overstrike',KEY_NAME(CTRL_A_KEY), "Insert_overstrike_modes."); ! ctrl a DEFINE_KEY('EDTP$Copy_To_End_Of_Buffer',KEY_NAME('A',SHIFT_KEY), "Copy_End_buffer."); ! gold a DEFINE_KEY('EDTP$Tab_adjust',KEY_NAME(CTRL_A_KEY,SHIFT_KEY), "Tab_Adjust"); ! gold ctrl a DEFINE_KEY ('EDTP$Set_Buffer',KEY_NAME('B',SHIFT_KEY), "Change_buffer."); ! gold b DEFINE_KEY('EDTP$Copy',KEY_NAME("C",SHIFT_KEY), "Copy_buffer"); ! gold c DEFINE_KEY('EDTP$decrease_tab', ctrl_d_key,"Decrease_Tab"); ! ctrl d DEFINE_KEY ('EDTP$swap_delim',KEY_NAME(CTRL_D_KEY,SHIFT_KEY), "word_delimmiters"); ! gold ctrl d DEFINE_KEY ('EDTP$SPAWN', KEY_NAME('D',SHIFT_KEY), "SPAWN_command."); ! gold d DEFINE_KEY ('EDTP$Set_Search', KEY_NAME('E',SHIFT_KEY), "Set_Search"); ! gold e DEFINE_KEY('EDTP$increase_tab', key_name(ctrl_e_key,shift_key),"Increase_Tab"); ! gold ctrl e DEFINE_KEY('EDTP$increase_tab', ctrl_e_key,"Increase_Tab"); ! ctrl e DEFINE_KEY ('EDTP$fill_parag',KEY_NAME('F',SHIFT_KEY), "Fill_paragraph."); ! gold f DEFINE_KEY ('EDTP$FORTRAN_Help',KEY_NAME(CTRL_F_KEY,SHIFT_KEY), "FORTRAN_HELP"); ! gold ctrl f DEFINE_KEY ('EDTP$get_key_info',KEY_NAME('H',SHIFT_KEY), "Terse_Help"); ! gold h DEFINE_KEY ('EDTP$DCL_Help',KEY_NAME(CTRL_H_KEY,SHIFT_KEY), "DCL_HELP"); ! gold ctrl h DEFINE_KEY ('EDTP$include_file',KEY_NAME('I',SHIFT_KEY), "Include_file"); ! gold i DEFINE_KEY ('EDTP$Set_tabs',KEY_NAME(CTRL_I_KEY,SHIFT_KEY), "Set_Tabs"); ! gold ctrl i DEFINE_KEY('EDTP$tab',tab_key,"TAB"); ! ctrl i (tab key) DEFINE_KEY('EDTP$del_beg_word',f13,"LINEFEED"); ! ctrl j (line feed) DEFINE_KEY('EDTP$del_beg_word',lf_key,"LINEFEED"); ! ctrl j (line feed) DEFINE_KEY ('EDTP$tab_jump',KEY_NAME(CTRL_J_KEY,SHIFT_KEY), "Jump_Tab"); ! gold cntrl j DEFINE_KEY ('EDTP$Kut', KEY_NAME('K',SHIFT_KEY), "Cut_buffer"); ! gold k DEFINE_KEY ('EDTP$Show_tabs',KEY_NAME(CTRL_K_KEY,SHIFT_KEY), "Show_Tabs"); ! gold ctrl k DEFINE_KEY('EDTP$DEFINE_KEY',ctrl_k_key,"DEFINE_KEY"); ! ctrl k DEFINE_KEY('copy_text(ascii(12))',ctrl_l_key,"LINEFEED"); ! ctrl l DEFINE_KEY ('EDTP$RESTORE' , KEY_NAME(CTRL_L_KEY,SHIFT_KEY), "Find_marker"); ! gold ctrl l DEFINE_KEY ('COPY_TEXT ("^^&&^^")' , KEY_NAME(CTRL_M_KEY,SHIFT_KEY), "Insert_marker"); ! gold ctrl m DEFINE_KEY ('EDTP$main_buf',KEY_NAME('M',SHIFT_KEY), "Main_buffer."); ! gold m DEFINE_KEY ('EDTP$Remove_Page_Marks', KEY_NAME('N',SHIFT_KEY), "Normalize"); ! gold n DEFINE_KEY ('EDTP$Set_parameters', CTRL_N_KEY, "WP_Prog"); ! ctrl n DEFINE_KEY ('EDTP$Set_Wrap', KEY_NAME(CTRL_N_KEY,SHIFT_KEY), "Toggle_Wrap"); ! gold ctrl n DEFINE_KEY ('EDTP$Write_Buffer',KEY_NAME('O',SHIFT_KEY), "Write_buffer"); ! gold o ! page 119 DEFINE_KEY ('EDTP$Paste_Buf',KEY_NAME('P',SHIFT_KEY), "PASTE_buffer"); ! gold p DEFINE_KEY ('EDTP$Insert_Page_Marks',CTRL_P_KEY, "Paginate"); ! ctrl p DEFINE_KEY ('EDTP$PL1_Help', KEY_NAME(CTRL_P_KEY,SHIFT_KEY), "PL1_Help"); ! gold ctrl p DEFINE_KEY ('QUIT',KEY_NAME('Q',SHIFT_KEY), "Quit"); ! gold q DEFINE_KEY ('EDTP$Insert_Ruler',KEY_NAME(CTRL_R_KEY,SHIFT_KEY), "Insert_ruler"); ! gold ctrl r DEFINE_KEY ('EDTP$replace_string',KEY_NAME('R',SHIFT_KEY), "Replace_String"); ! gold r DEFINE_KEY("EDTP$Column_Cut_Or_Paste",CTRL_R_KEY,"Column"); ! ctrl r DEFINE_KEY ('EDTP$show_buf',KEY_NAME('S',SHIFT_KEY), "Show_buffer"); ! gold s DEFINE_KEY('EDTP$tab_adjust', key_name('T',shift_key),"TAB_ADJUST"); ! gold ctrl t DEFINE_KEY('EDTP$tab_adjust', ctrl_t_key,"TAB_ADJUST"); ! ctrl t DEFINE_KEY('EDTP$delete_beg_line',ctrl_u_key,"DEL_BEG_LINE"); ! ctrl u DEFINE_KEY ('EDTP$TPU_command',KEY_NAME('U',SHIFT_KEY), "TPU_Command"); ! gold u DEFINE_KEY("refresh",ctrl_w_key,"REFRESH"); ! ctrl w DEFINE_KEY ('EDTP$Change_Width', KEY_NAME(CTRL_W_KEY,SHIFT_KEY), "Change_width."); ! gold ctrl w DEFINE_KEY('EDTP$Make_Windows',KEY_NAME('W',SHIFT_KEY), "Windows."); ! gold w DEFINE_KEY ('EDTP$get_out', KEY_NAME('X',SHIFT_KEY), "EXIT"); ! gold x DEFINE_KEY ('EDTP$Change_Windows',KEY_NAME('Y',SHIFT_KEY), "Change_Windows"); ! gold y DEFINE_KEY ('EDTP$Insert_Page_Marks',KEY_NAME("Z",SHIFT_KEY), "Paginate"); ! gold z DEFINE_KEY ('EDTP$Prompt_on_EXIT', KEY_NAME(CTRL_Z_KEY,SHIFT_KEY), "File_EXIT"); ! gold ctrl z DEFINE_KEY ('EDTP$Line_mode(EDTP$Multi_line)', CTRL_Z_KEY,"EDT_Line_mode"); ! ctrl z ! DEFINE_KEY("split_line",ret_key,"return"); ! return DEFINE_KEY('EDTP$backspace',f12,"backspace"); ! Backspace DEFINE_KEY('EDTP$backspace',bs_key,"backspace"); ! Backspace DEFINE_KEY('EDTP$rubout',del_key,"delete") ; ! rubout temp_string := 'set(status_line,info_window,EDTP$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 117 ! ! 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)); DEFINE_KEY('EDTP$gold_number("1")',key_name('1',shift_key)); DEFINE_KEY('EDTP$gold_number("2")',key_name('2',shift_key)); DEFINE_KEY('EDTP$gold_number("3")',key_name('3',shift_key)); DEFINE_KEY('EDTP$gold_number("4")',key_name('4',shift_key)); DEFINE_KEY('EDTP$gold_number("5")',key_name('5',shift_key)); DEFINE_KEY('EDTP$gold_number("6")',key_name('6',shift_key)); DEFINE_KEY('EDTP$gold_number("7")',key_name('7',shift_key)); DEFINE_KEY('EDTP$gold_number("8")',key_name('8',shift_key)); DEFINE_KEY('EDTP$gold_number("9")',key_name('9',shift_key)); DEFINE_KEY('EDTP$gold_number(EDTP$x_empty)',key_name('+',shift_key)); DEFINE_KEY('EDTP$gold_number("-")',key_name('-',shift_key)); ! ! Define special symbol keys ! DEFINE_KEY ('EDTP$Insert_DCL_Comment',KEY_NAME('$',SHIFT_KEY), "DCL_Comment"); ! gold $ DEFINE_KEY ('EDTP$Insert_FORT_Comment',KEY_NAME('*',SHIFT_KEY), "FORTRAN_Comment"); ! gold * DEFINE_KEY ('EDTP$Swap_2_Characters', KEY_NAME('\',SHIFT_KEY), "Swap_Characters"); ! gold \ DEFINE_KEY ('EDTP$erase_buf',KEY_NAME(DEL_KEY,SHIFT_KEY), "Erase_buffer"); ! gold DELETE DEFINE_KEY ('EDTP$top_sent',KEY_NAME('.',SHIFT_KEY), "Back_sentence"); ! gold . DEFINE_KEY ('EDTP$end_sent',KEY_NAME('!',SHIFT_KEY), "Forward_sentence"); ! gold ! DEFINE_KEY ('EDTP$get_key_info',KEY_NAME('?',SHIFT_KEY), "Terse_help"); ! gold ? DEFINE_KEY ('EDTP$Find_Line', KEY_NAME('#',SHIFT_KEY), "Find_line"); ! gold # DEFINE_KEY ('EDTP$top_parag',KEY_NAME('@',SHIFT_KEY), "back_paragraph"); ! gold @ DEFINE_KEY ('EDTP$end_parag',KEY_NAME('/',SHIFT_KEY), "Forward_paragraph"); ! gold / DEFINE_KEY('EDTP$Learning',KEY_NAME('[',SHIFT_KEY), 'Learn_Start'); ! gold [ DEFINE_KEY('EDTP$Stop_Learn',KEY_NAME(']',SHIFT_KEY), 'Learn_End'); ! gold ] ENDPROCEDURE ! page 118 ! 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 EDTP$init_variables; ! ! Create all the necessary default buffers and windows ! ! Get the help buffer help_buffer := create_buffer("HELP"); set(eob_text,help_buffer,EDTP$x_empty); set(no_write,help_buffer); set(system,help_buffer); ! ! 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,EDTP$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,EDTP$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); ! page 119 ! ! 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,EDTP$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)=EDTP$x_empty ) AND (input_file <> EDTP$x_empty) then ! exit immediately if file not there message('Input file does not exist: '+temp); exit else temp:=file_search(EDTP$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'); ! page 120 if (output_file_name <> EDTP$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, EDTP$x_empty, EDTP$x_empty, NAME) + file_parse (input_file, EDTP$x_empty, EDTP$x_empty, TYPE); parsed_output_file_name := file_parse (output_file_name, 'sys$disk:[]', input_file_name_only); if parsed_output_file_name <> EDTP$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 - 2),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 = EDTP$x_empty then input_file_name_only := "TPU.TJL"; else input_file_name_only := file_parse (input_file, EDTP$x_empty, EDTP$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; ! page 121 ! ! Go to the current position in the main buffer ! position(main_window); tpu$local_init; ! ! Go and read information in user files and do final set up ! EDTP$Wrap_Setting_1 := 79; EDTP$Wrap_Setting_2 := 65; EDTP$Windows := "OFF"; EDTP$User_Commands; EDTP$Set_beginning_Tabs; CHANGE_CASE(EDTP$Clear_Message,UPPER); EDTP$x_wrap_position := EDTP$Wrap_Setting_1; EDTP$buffer_nam_1 := get_info(current_buffer,"name"); EDTP$window_nam_1 := current_window; ! EDTP$window_size := 21; EDTP$Set_Status_line(CURRENT_WINDOW); IF (EDTP$Clear_Message = "YES") THEN ERASE(MESSAGE_BUFFER); ENDIF; ! ! Set bell on only after the set up has been completed ! SET (BELL,ALL,ON); ENDPROCEDURE ! page 122 ! ! This is the code to be executed when the section is being built ! EDTP$DEFINE_KEYs; ! bind keys ! ! Relinguish memory taken up (unnecessarily) by the EDTP$DEFINE_KEYs procedure. ! Saves 15 blocks of space. ! compile ('PROCEDURE EDTP$DEFINE_KEYs ENDPROCEDURE'); save('EDTP$TPU:EDTPSECINI.NEW'); quit