!                                                                       Page 1
!
!                      COPYRIGHT © 1983, 1984, 1985 BY
!               DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
!                           ALL RIGHTS RESERVED
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY:
!	Text Processing Utility (VAXTPU)
!
! ABSTRACT:
!      This is the VAXTPU source program for the EDT emulator interface
!
! ENVIRONMENT:
!	VAX/VMS
!
!Authors: Sharon Burlingame, Steve Long, Terrell Mitchell
!
! CREATION DATE: 1-June-1983
!
! MODIFIED BY:
!		J. Clement
!		Many features added, and made more compatible with EDT.
!		Line mode commands added: COPY, MOVE, TYPE
!		Fixed character position for imbedded tabs
!		Fixed command SET SCOPE to work with all windows
!		Added code recognition to Special insert.
!
!--
!       EDTSECINI.TPU
!
!       Table of Contents as of 23-Nov-1985
!
!       Procedure name              Page    Description
!       --------------              ----    ------------
!
!       edt$init_variables             2    initialize global variables
!       edt$append                     4    kp9 (append)
!       edt$backspace                  5    backspace key
!       edt$command                    6    (TPU command)
!       edt$change_case                7    gold kp1 (change case)
!       edt$cut                        8    kp6 ( cut selected text)
!       edt$on_search_range            8    Select and substitute support routine
!       edt$select_range               8    cut support routine
!       edt$decrease_tab               9    ctrl d (decrease tab level)
!       edt$define_key                 9    ctrl k (define key)
!       edt$delete_char                10    keypad comma (delete chr)
!       edt$delete_beg_line            11    ctrl u ( delete to beg. of line)
!       edt$delete_end_word            12    keypad minus (delete word)
!       edt$delete_line                12    pf4 (delete line)
!       edt$delete_to_eol              12    gold kp2 ( delete to end of line)
!       edt$end_of_line                13    kp2 (move to end of line)
!       edt$fill                       14    gold kp8 (fill)
!       edt$preserve_blanks            14    support routine for fill
!       edt$skip_leading_spaces        15    support routine for fill
!       edt$find_whiteline             15    support routine for fill
!       edt$skip_lines                 15    support routine for fill
!       edt$gold_number                16    gold 0..9 (repeat counts)
!       edt$help                       17    gold pf2 (help on topic)
!       edt$increase_tab               17    ctrl e (increase tab level)
!       edt$keypad_help                18    pf2 (keypad help)
!       edt$create_keypad_diagram      18    support routine for keypad help
!       edt$get_keypad_diagram         18    support routine for keypad help
!       edt$Line_mode                  19    ctrl z (line mode)
!       edt$next_Token                 20    support routine for line mode
!       edt$find_buffer                21    support routine for line mode
!       edt$range_specification        21    support routine for line mode
!       edt$buffer                     22    support routine for line mode(= buffer cmd)
!       edt$show                       23    support routine for line mode(show cmd)
!       edt$set                        24    support routine for line mode(set cmd)
!	edt$line_mode_copy	  J.C. 24    support routine for line mode(copy,move)
!       edt$write                      25    support routine for line mode(write cmd)
!       edt$include                    26    support routine for line mode(include cmd)
!       edt$quit                       27    support routine for line mode(quit cmd)
!       edt$exit                       27    support routine for line mode(exit cmd)
!       edt$line_mode_substitute       28    support routine for line mode(subs cmd)
!       edt$find_sub_delimiter         28    support routine for subs cmd
!       edt$global_search_replace      29    support routine for subs cmd
!       edt$move_word                  30    kp2 (move word)
!       edt$move_word_r                30    support routine for move word (reverse)
!       edt$move_word_f                30    support routine for move word (forward)
!       edt$del_beg_word               30    support routine for delete word (forward)
!       edt$beg_word                   30    support routine for move word
!       edt$end_word                   30    support routine for delete word
!       edt$next_prev_line             31    kp0 (next line)
!       edt$page                       32    kp7 (move to next page)
!       edt$paste                      32    gold kp6 (paste selected text)
!       edt$replace                    32    gold kp9 (replace)
!       edt$reset                      33    gold kepypad dot(reset)
!       edt$rubout                     33    rubout key (erase prev chr)
!	edt$specins		  J.C. 33    Gold kp3 (special insert)
!       edt$search                J.C. 34    gold pf3 (search)
!       edt$search2               J.C. 34    KP4,KP5, ENTER during search input
!       edt$search_next                34    pf3 (search next)
!	     J. Clement
!	edt$move_horizontal	       35	left_arrow
!	edt$move_horizontal	       35	right_arrow
!	edt$move_vertical	       35	down_arrow
!	edt$move_vertical	       35	up_arrow
!		---------
!       edt$section                    35    kp8 (section)
!       edt$select                     35    keypad dot (select)
!       edt$substitute                 35    gold enter (substitute)
!       edt$cancel_subs                35    support routine for substitute
!       edt$tab                        36    tab key
!       edt$tab_adjust                 36    ctrl t (adjust tabs)
!       edt$undelete_char              37    gold comma (undelete character)
!       edt$undelete_line              37    gold pf4 (undelete line)
!       edt$undelete_word              37    gold keypad minus(undelete word)
!       edt$on_end_of_line             38    support routine for undelete
!       edt$wrap_word                  39    space key (wrap word)
!       EDT$define_keys                40    define all keys
!       tpu$local_init                 45    local initialization
!       tpu$init_procedure             45    initialization procedure

!                                                                       Page 2
!+
! Procedures with names beginning with edt$ are edt commands. These
! procedures are subject to change.  In the future, Digital may supply
! new procedures beginning with edt$, remove some of the edt$ procedures,
! or change existing edt$ procedures.  The same is true for global variables
! with names beginning with edt$.  User-written procedures should not
! begin with edt$.
!-
procedure edt$init_variables		! initialize global variables
!
! Initialize some variables
!
!
! Create the null variable
!
edt$x_empty := '';
!
! Each command must be eleven characters long, with the first being a space
TRUE:=1;
FALSE:=0;
edt$x_commands := 0;
edt$x_version := 'Version  TPU V'+str(get_info(system,'version'))+'.'+
		str(get_info(system,'update')) +
                ' - ' + 'EDT Emulator BL1.0';
edt$x_prompt := false;
edt$x_numeric :='+-0123456789';
edt$x_special_char := '!@#$%^&*()_=~`{}[];:''"|\,./<>?';
edt$x_alpha := 'abcdefghijklmnopqrstuvwxyz'+'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
edt$x_nonalpha := edt$x_special_char+edt$x_numeric;
edt$x_nonnumeric := edt$x_alpha+edt$x_special_char;
edt$x_current_column := 0;		! No current column number
edt$x_search_begin := 1;
edt$x_terminators := ' 	=%';
edt$x_subs_term := edt$x_nonalpha;
edt$x_word_delim := " 	<FF><LF><CR><VT>";
edt$x_codes :=
	' NUL  SOH  STX  ETX  EOT  ENQ  ACK  BEL '+
	' BS   HT   LF   VT   FF   CR   SO   SI  '+
	' DLE  XON  DC2  XOF  DC4  NAK  SYN  ETB '+
	' CAN  EM   SUB  ESC  FS   GS   RS   US  ';
edt$x_word := " 	

";
edt$x_prefixes := '	 %';
edt$x_wrap_position := 0;
edt$x_tab_size := 4;
edt$x_tab_goal := 8;
edt$x_tabs_set := 1;
edt$x_keypad_window := 0;
edt$x_delete_crlf:=0;
edt$x_appended_line := 0;
edt$x_section_distance:=16;
edt$x_beginning_of_select := 0;
edt$x_search_pattern := edt$x_empty;
edt$x_search_string := edt$x_empty;
edt$x_search_query := false;
edt$x_search_log := false;
edt$x_search_case := no_exact;
edt$x_deleted_char := edt$x_empty;
edt$x_deleted_word := edt$x_empty;
edt$x_deleted_line := edt$x_empty;
edt$x_search_range :=0;
edt$x_select_range := 0;
edt$x_repeat_count := 1;
edt$x_search_video := 0;		! Initially no search video
edt$x_select_video :=reverse;
edt$x_info_stats_video := none;
edt$x_control_chars := "
	

";

!                                                                       Page 3
edt$x_forward_word:=
! don't move off current character position
	      (
	      anchor
		&
! if on eol,then match that
              (
	      (line_end)
	      |
!leading spaces,on a word delimiter
	     (span(' ') ) )		!((span(' ')) & (any(edt$x_word) | edt$x_empty) ) )
	      |
!no leading spaces,on a word delimiter,move one past it
	      (any(edt$x_word))
	      |
!no leading spaces,on a real word,go one beyond it
	      (scan(edt$x_word))
	      |
!no leading spaces,on a last real word of line, match rest of line
	      REmain
             )
	     &
! after matching, skip over trailing spaces if any
! except if match occurred at the eol. In this case,don't skip over blanks

	     (line_begin|span(' ') | edt$x_empty)
;
endprocedure

!                                                                       Page 4
!+
! EDT APPEND
!-
procedure edt$append			!kp9 (append)

LOCAL	 temp_pos ;
edt$select_range;
if edt$x_select_range <> 0
then
    temp_pos := mark(none);
    position(end_of(paste_buffer));
    move_horizontal(-1);
    move_text(edt$x_select_range);
    edt$x_select_range:=0;
    position(temp_pos);
else
    message("No Select Active");
    edt$x_repeat_count := 1;
endif;
endprocedure

!                                                                       Page 5
!+
! EDT Backspace
!-
procedure edt$backspace			!backspace key

LOCAL	 temp_length ;
edt$x_current_column := 0;		! No current column number
temp_length := current_offset;
if temp_length = 0
then
	move_vertical(-1) ;
	move_horizontal(- current_offset);  ! Make sure we are at 0
else
	move_horizontal(-temp_length)
endif;
endprocedure

!                                                                       Page 6
!+
! EDT gold 7 emulation(command line processing)
!-
procedure edt$command(input_line)		!(TPU command)

LOCAL	line_read,
	temp_string,
	x;
!+
! Trap compilation failures
!-
ON_ERROR
   IF error = tpu$_compilefail
   THEN
      message ('Unrecognized command');
      RETURN
   ENDIF;
	Edt$X_REPEAT_COUNT:=1;
ENDON_ERROR
!
! input: prompt string
! outputs: function returns true if string read is NOT compiled
!
!+
! Get the command(s) to execute
!-
loop;
    if input_line = edt$x_empty then
	line_read:=read_line('TPU Command: '); ! get line from user
    else
	line_read:=input_line
    endif;
	edit (line_read, trim_leading, trim_trailing, OFF);
    if line_read = edt$x_empty then
	return;
    else;
!+
! Make sure that the person didn't type help, or some form
! of help - if so, display help for TPU
!-
	temp_string := line_read;
	edit (temp_string,trim,upper);
	if (index (temp_string,'HELP') = 1) then
	    edt$help ('VAXTPU '+substr(temp_string,5,length(temp_string)));
	else;
!+
! compile them
!-
	    x:=compile(line_read);
!+
! execute
!-
	    if x <> 0 then
		execute(x);
	    endif;
	endif;
    endif;
    IF current_window = info_window then; 
	update(current_window);
	temp_str := read_line('Press RETURN to continue.',1);
	unmap(current_window);
    endif;
    exitif input_line <> edt$x_empty;
endloop;
endprocedure

!                                                                       Page 7
!+
!EDT CHANGECASE
!-
procedure edt$change_case		!gold kp1 (change case)

LOCAL	 character ;
!check for active select
edt$select_range;
if edt$x_select_range <> 0
then
    change_case(edt$x_select_range,invert);
    edt$x_select_range:=0;
    return;
endif;

!change case of current character

if current_character <> edt$x_empty
then
     character :=current_character;
     change_case(character,invert);
     erase_character(1);
     copy_text(character);
     if current_direction <> forward
     then
	 move_horizontal(-2);
     endif;
     return
endif;
endprocedure

!                                                                       Page 8
!+
! EDT CUT
!-
! After erasing the paste buffer, insert a blank line. This blank
! line is needed for the PASTE operation. When doing the paste, have
! to know if the line terminator on the last line should be included
! in the new text.
!-
procedure edt$cut			!kp6 ( cut selected text)

LOCAL	 temp_position ;
edt$select_range;
if edt$x_select_range <> 0
then
    temp_position := mark(none);
    erase(paste_buffer);
    position(paste_buffer);
    split_line;
    move_vertical(-1);
    move_text(edt$x_select_range);
    position(temp_position);
    edt$x_select_range:=0;
else
    message("No Select Active");
    edt$x_repeat_count := 1;
endif;
endprocedure

!+
! Procedure to determine if we are sitting on the search range.
!-
procedure edt$on_search_range		! Select and substitute support routine
local
    v_on_search;

if (edt$x_search_begin)
then
! If SET SEARCH BEGIN is active then we should be sitting on the first
! character of the select range
    if (mark(none) = beginning_of(edt$x_search_range))
    then
	v_on_search := 1;
    else
 	v_on_search := 0;
    endif;
else
! If SET SEARCH END is active, then we need to move back one in order
! to determine if a search range selection is active
    move_horizontal(-1);
    if mark(none) = END_OF(edt$x_search_range)
    then
  	v_on_search := 1;
    else
    	v_on_search := 0;
    endif;
    move_horizontal(1);
endif;

return v_on_search;
endprocedure;

!+
! Procedure to create the select range
!-
procedure edt$select_range		! cut support routine

if (edt$x_beginning_of_select <> 0)
then
    edt$x_select_range := select_range;
! If the select range is zero, this means that we are still
! positioned on the beginning of the select range.  Create
! a range of length zero so that EDT emulation works better.
    if (edt$x_select_range = 0)
    then
        position (end_of(current_buffer));
        edt$x_select_range := create_range (mark(none), mark(none), none);
        position (edt$x_beginning_of_select);
    endif;
    edt$x_beginning_of_select := 0;
else
! Check for being on search string and repeat count <= 1
    if (edt$x_search_range <> 0)
    then
	if (edt$on_search_range = 1) AND (edt$x_repeat_count <= 1)
	then
	    edt$x_select_range := edt$x_search_range;
	else
	    edt$x_select_range := 0;
	endif
    else
	edt$x_select_range := 0;
    endif;
endif;
if edt$x_select_range <> 0 then;
	edt$x_current_column := 0;		! No current column number
endif;
endprocedure

!                                                                       Page 9
!
! EDT ctrl d
!
procedure edt$decrease_tab 			!ctrl d (decrease tab level)
edt$x_tab_goal := edt$x_tab_goal - edt$x_tab_size;
if (edt$x_tab_goal < 0) then edt$x_tab_goal := 0 endif;
endprocedure;



!+
! EDT ctrl k (Define Key)
!-
procedure edt$define_key			!ctrl k (define key)
LOCAL	def,
	input_key;
def := read_line('Definition: ');
input_key := read_line('Press key to define.',1);
input_key := last_key;
define_key(def,input_key);
endprocedure


!                                                                       Page 10
!
! EDT DELETE CHARACTER
!
procedure edt$delete_char			!keypad comma (delete chr)
local
    temp_line;

edt$x_current_column := 0;		! No current column number
if mark(none) = end_of(current_buffer)
then
    message ('Attempt to advance past the end of buffer '+
		get_info(current_buffer,"name"));
else
    edt$x_deleted_char := erase_character(1);
    if (edt$x_deleted_char = edt$x_empty)
    then
	edt$x_deleted_char := ascii(10);
	temp_line := current_line;
    	move_horizontal(1);
    	if (mark(none) <> end_of(current_buffer)) or (length(temp_line) = 0)
    	then
	    append_line;
    	else
	    move_horizontal (-1);
    	endif;
    endif;
endif;
endprocedure

!                                                                       Page 11
!
! EDT	Delete to the beginning of the line
!
!
procedure edt$delete_beg_line		!ctrl u ( delete to beg. of line)
edt$x_current_column := 0;		! No current column number
edt$x_deleted_line := erase_character(- current_offset);
if edt$x_deleted_line = edt$x_empty                      ! then delete previous line
then
	if mark(none) <> beginning_of(current_buffer)
	then
		move_vertical(-1);
		edt$delete_line;        ! delete the entire previous line
	endif;
endif;
edt$x_delete_crlf := 0;
edt$x_appended_line := 0;
endprocedure

!                                                                       Page 12
!
! Delete to end of word
!
procedure edt$delete_end_word		! keypad minus (delete word)

LOCAL	 temp_length ;
temp_length := edt$end_word;
if temp_length = 0		! then we are on eol
then
	     edt$x_deleted_word:=ascii(10);  ! line feed
	     if mark(none) <> end_of (current_buffer) then
	         move_horizontal(1);
		 if mark(none) <> end_of (current_buffer) then
	             append_line;	  ! join both lines
		 else
		    move_horizontal (-1);
		 endif;
	     endif;
else
	     edt$x_deleted_word := erase_character(- temp_length)	! delete the word
endif;
endprocedure

!
! EDT delete line
!
!
procedure edt$delete_line		!pf4 (delete line)
edt$x_current_column := 0;		! No current column number
if current_offset = 0
then
     edt$x_deleted_line := erase_line
else
     edt$x_deleted_line := erase_character(length(current_line));
     move_horizontal(- current_offset );
     move_vertical(1);
     if mark(none) <> end_of(current_buffer)
     then
	 append_line
     else
	 move_horizontal(-1)
     endif;
endif;
edt$x_delete_crlf := 1;
edt$x_appended_line := 0;
endprocedure


!
!
! EDT Delete to the end of the line
!
!
procedure edt$delete_to_eol		!gold kp2 ( delete to end of line)
!The below line works because the erase_character will stop at the end of line
! we will only pick up from the current point to the end of the line unless
! we are already on the end of line.  In this case we are supposed to deleted
! the line terminator plus the entire next line.
!
edt$x_current_column := 0;		! No current column number
if current_offset = length (current_line)
then
    move_vertical(1);
    if mark(none) <> end_of (current_buffer)
    then
        move_horizontal (-current_offset);
	edt$x_deleted_line := erase_line;
	edt$x_appended_line := 1;
	edt$x_delete_crlf := 0;
    else
	edt$x_appended_line := 0;
	edt$x_delete_crlf := 1;
    endif;
    move_horizontal (-1);
else
    edt$x_deleted_line := erase_character(length(current_line));
    edt$x_appended_line := 0;
    edt$x_delete_crlf := 0;
endif;
endprocedure

!                                                                       Page 13
!+
! Move the next End of Line
!-
procedure edt$end_of_line		!kp2 (move to end of line)
edt$x_current_column := 0;		! No current column number
if current_direction = forward
then
	if mark(none) <> end_of (current_buffer)
	then
 	    if edt$on_end_of_line
	    then
		move_vertical(1)
	    endif;		 	! move back
	    if mark(none) <> end_of(current_buffer)
	    then
		move_horizontal(length(current_line)-current_offset); ! goto EOL
	    endif;
	endif
else
	move_horizontal(( - current_offset)+(-1))
endif;
endprocedure			! end of EOL

!                                                                       Page 14
!+
! EDT FILL
!-
procedure edt$fill 			!gold kp8 (fill)

edt$select_range;
if edt$x_select_range <> 0
then
! patterns for matching multiple blank lines

	edt$x_whit_pat:=line_begin &(line_end|(span('	 ')
			&line_end))&line_begin;
 if (edt$x_wrap_position = 0)
    then
        edt$preserve_blanks(0)
    else
	edt$preserve_blanks(1)
   endif;
    edt$x_select_range := 0;
else
    message("No Select Active");
    edt$x_repeat_count := 1;
endif;
endprocedure

procedure edt$preserve_blanks(flag)    ! support routine for fill
LOCAL 	original_position,
	b_mark,
	e_mark,
	sub_range,
	temp_range,
	all_done,
	temp_pattern;

on_error
all_done:=1; ! cause exit
endon_error;

	original_position:=mark(none);
	b_mark:=beginning_of(edt$x_select_range);

! skip leading spaces on first line only

	edt$skip_leading_spaces(b_mark);
	position(original_position);

	loop
	! skip leading blank lines of a paragraph
	edt$skip_lines(b_mark);
	all_done:=edt$find_whiteline(b_mark,e_mark); ! start looking here

	exitif  all_done;

! now only fill the range created between the blank lines

	sub_range:=create_range(b_mark,e_mark,none);

! go to line following the range
	position(e_mark);
	move_horizontal(1);
	move_vertical(1);

! pick up search at end of current_range
	b_mark:=mark(none);

! do the fill operation

	if flag then
		fill(sub_range,edt$x_word,1,edt$x_wrap_position);
	  else
		fill(sub_range,edt$x_word,1,get_info(current_window,'width'));
	endif;
exitif all_done;
endloop;
position(original_position);
endprocedure

!                                                                       Page 15
!
procedure edt$skip_leading_spaces(b_mark)	! support routine for fill
local temp_pattern,temp_range;

on_error
return
endon_error;
	position(b_mark);
	temp_pattern:=anchor&span(' 	');
	temp_range:=search(temp_pattern,forward);
	position(end_of(temp_range));
	move_horizontal(1);
	b_mark:=mark(none);
endprocedure

procedure edt$find_whiteline(beg_mark,end_mark)  ! support routine for fill
local
	bline;
on_error
position(beg_mark);
end_mark:= end_of(edt$x_select_range);
return 0;
endon_error;

position(beg_mark);

if beg_mark >= end_of(edt$x_select_range)
  then
	return 1 ! all done
endif;



bline:=search(edt$x_whit_pat,forward);

! get the beginning and end points right

if beginning_of(bline) > end_of(edt$x_select_range)
	then
	end_mark:= end_of(edt$x_select_range);
	return 0
        Else

	end_mark:=end_of(bline);
endif;

position(end_mark); ! go there
move_horizontal(-1); ! back up to previous line
end_mark:=mark(none);

return 0
endprocedure

procedure edt$skip_lines(where)			! support routine for fill

!skip multiple blank lines
! once that one blank line is found

on_error
where:=mark(none);
return;
endon_error;
position(where);
loop
	if current_line <> edt$x_empty
		then exitif;
	endif;
	move_vertical(1);
	move_horizontal(-current_offset);
endloop;
where:=mark(none);
return
endprocedure

!                                                                       Page 16
!+
! Procedures for emulating the EDT style GOLD digit commands.
!-
procedure edt$gold_number ( first_digit)   !gold 0..9 (repeat counts)
LOCAL	number ,
	ascii_char ,
	term_char ,
	exe_flag ,
	curr_window,
	key_code ;
ON_ERROR;
	Edt$X_REPEAT_COUNT:=1;
	set (screen_update,on);
endon_error;
!+
! Now get the count in here
!-
curr_window:=current_window;
number := first_digit;
erase(prompt_buffer);
Set(eob_text,prompt_buffer,"Then press key to repeat");
position(prompt_buffer);
copy_text("Repeat:"+number);
map(prompt_window,prompt_buffer);
update(prompt_window);
loop
	term_char := read_key;
	ascii_char := ascii(term_char);
	If term_char = del_key then
		If length(number) > 0 then
			number:=substr(number,1,length(number)-1);
			erase_character(-1);
		else;
			number:=edt$x_empty;
		endif;
		term_char :=0;
	endif;
	if (index('0123456789',ascii_char) <> 0) then
		number := number + ascii_char;
		copy_text(ascii_char);
		term_char :=0;
	endif;
	If term_char <> 0 then;
		! Check if it is normal ascii not control
		if (term_char = key_name(ascii_char)) and
		   (index(edt$x_control_chars,ascii_char) = 0) then
			term_char := ascii(term_char);	! Now is char.
			exe_flag := 0;
		else;
			exe_flag := 1;
		endif;
		exitif ;
	endif;
	update(prompt_window);
endloop;
unmap(prompt_window);
update(message_window);
position(curr_window);
!
! Get the numeric value
!
!	Suppress bad sequences
!
IF (term_char = key_name("0",shift_key)) or
   (term_char = key_name("1",shift_key)) or
   (term_char = key_name("2",shift_key)) or
   (term_char = key_name("3",shift_key)) or
   (term_char = key_name("4",shift_key)) or
   (term_char = key_name("5",shift_key)) or
   (term_char = key_name("6",shift_key)) or
   (term_char = key_name("7",shift_key)) or
   (term_char = key_name("8",shift_key)) or
   (term_char = key_name("9",shift_key)) then
	number := edt$x_empty;
	message("Illegal key selected for repeat")
endif;
edt$x_repeat_count := int(number);
if edt$x_repeat_count > 0 then;		! Repeat count ok ?
   if exe_flag = 1 then			! Not text char ?
!
! If the key was special insert, just stick the character in
! If it wasn't then they are trying to do repeat counts.
!
	if term_char = key_name(kp3,shift_key)
	then
		copy_text(ascii(edt$x_repeat_count))
	else
!
! Look up the key definition. If there was one, then execute it
! If there isn't a definition, check to see if it is an alphabetic they
! are trying to insert.
!
		if (term_char = key_name(kp7,shift_key))
		then
			! The guy is doing an interactive command, get his command first
			term_char := read_line('TPU Command: ');
			if (term_char = edt$x_empty)
			then
				key_code := 0;
			else
				key_code := compile(term_char);
			endif
		else
!
!	Key exists ?
!
			if length (lookup_key(term_char,key_map)) = 0 then
				message('Key not defined');
				edt$x_repeat_count := 1;
				return;
			endif;
			key_code := lookup_key(term_char,program);
		endif;
		if key_code <> 0
		then
			exe_flag := 0;
!			set (screen_update,off);
			loop
				execute(key_code);
				edt$x_repeat_count := edt$x_repeat_count - 1;
				exitif edt$x_repeat_count < 1;
			endloop;
!			set (screen_update,on);
		endif;
	endif
   else
	loop
		copy_text(term_char);
		edt$x_repeat_count := edt$x_repeat_count - 1;
		exitif edt$x_repeat_count < 1;
	endloop;
   endif;
endif;
edt$x_repeat_count := 1;
endprocedure;

!                                                                       Page 17
!+
! TPU help
!-
procedure edt$help (topic_param)	! gold pf2 (help on topic)

if get_info(help_buffer,"type") = UNSPECIFIED
then
! Get the help buffer
   help_buffer := create_buffer("HELP");
   set(eob_text,help_buffer,edt$x_empty);
   set(no_write,help_buffer);
   set(system,help_buffer);
endif;

set(status_line,info_window,Reverse,
    'Press CTRL-Z to resume editing');
set(width,info_window,get_info(screen,'width'));
set(text,info_window,no_translate);
set(video,info_window,none);
set(pad,info_window,off);
erase (help_buffer);
map(info_window,help_buffer);
update(info_window);
if (topic_param = edt$x_empty)
then
    help_text('tpuhelp', read_line('Topic: '), on, help_buffer);
else
    help_text('tpuhelp', topic_param, on, help_buffer);
endif;
set(text,info_window,blank_tabs);
unmap(info_window);
set(pad,info_window,on);
set(video,info_window,reverse);
set(status_line,info_window,Reverse,' ');
endprocedure



!
procedure edt$increase_tab 	!ctrl e (increase tab level)
edt$x_tab_goal := edt$x_tab_goal + edt$x_tab_size;
unmap(info_window);
endprocedure

!                                                                       Page 18
!+
! EDT Help
!-
procedure edt$keypad_help		!pf2 (keypad help)
LOCAL
    diagram_prompt,
    text_prompt,
    current_prompt,
    temp_string,
    timer_string,
    help_key,
    comment_string;

! First check to see if the screen has at least a length of
! 22 or more - if not then this command doesn't
! make sense (may mess up the user's screen)
if (get_info (screen, "visible_length") < 22)
then
    message ('To use keypad help the screen must have length 22 or greater');
    return;
endif;
if (edt$x_keypad_window = 0)
then
    edt$create_keypad_diagram;
else
    edt$get_keypad_diagram;
endif;
! Turn off the timer temporarily
timer_string := get_info (system, 'timed_message');
if timer_string <> 0
then
   SET (TIMER, OFF);
endif;
diagram_prompt := 'Press the key that you want help on or RETURN to leave help                  ';
text_prompt :=    'Press the key that you want help on, PF2 for diagram, or RETURN to leave help';
set (status_line, edt$x_keypad_window, reverse, diagram_prompt);
map(edt$x_keypad_window,keypad_buffer);
update(edt$x_keypad_window);
help_key := READ_KEY;
!temp_string := READ_LINE (diagram_prompt, 0);
loop
!    help_key := last_key;
    comment_string := lookup_key (help_key, COMMENT);
    EXITIF comment_string = "return";
    if comment_string = "keypad_diagram"
    then
        edt$get_keypad_diagram;
        set (status_line, edt$x_keypad_window, reverse, diagram_prompt);
	current_prompt := diagram_prompt;
    else
        set (text, edt$x_keypad_window, blank_tabs);
        set (status_line, edt$x_keypad_window, reverse, text_prompt);
	current_prompt := text_prompt;
    	if comment_string = edt$x_empty
    	then
            comment_string := "no"
	endif;
	if substr(comment_string,1,1) = '$' then;	! Foreign ?
	    comment_string := substr(comment_string,2,length(comment_string)-1);
	    message(comment_string);
	    help_text ('tpuhelp', comment_string, off, keypad_buffer);
	else;
            help_text ('tpuhelp', 'edt_emulator keypad ' + comment_string,
		OFF, keypad_buffer);
	endif;
	position (beginning_of (keypad_buffer));
	erase_line;
	erase_line;
	erase_line;
	erase_line;
	position (beginning_of (keypad_buffer));
    endif;
    update(edt$x_keypad_window);
    help_key := READ_KEY;
!    temp_string := READ_LINE (current_prompt, 0);
endloop;
unmap (edt$x_keypad_window);
! Restore the timer
if timer_string <> 0
then
    SET (TIMER, ON);
endif;
endprocedure
!+
! Create the buffer and window for the keypad diagram.
!-
procedure edt$create_keypad_diagram	!support routine for keypad help
edt$x_keypad_window := create_window(1,22,off);
keypad_buffer := create_buffer('keypad');
set(no_write,keypad_buffer);
set(eob_text,keypad_buffer, edt$x_empty);
edt$get_keypad_diagram;
endprocedure
!+
! Get the keypad diagram into the editor
!-
procedure edt$get_keypad_diagram	!support routine for keypad help
! Do an error check - if the help buffer
! does not exist, then we have to return
! otherwise all of the lines in the current
! buffer will be deleted.
if (get_info (keypad_buffer, "type") = UNSPECIFIED)
then
    return;
endif;
! Pad the prompt to make it the same size as the text_prompt
set(text,edt$x_keypad_window,no_translate);
erase (keypad_buffer);
help_text('tpuhelp','keypad_dia edt_vt100',off,keypad_buffer);
! Go clean up the text in the buffer
position(beginning_of(keypad_buffer));
! Get rid of the topic lines
erase_line;
erase_line;
erase_line;
erase_line;
erase_line;
! Now delete the 5 spaces at the beginning of each line
loop
	exitif mark(none) = end_of(keypad_buffer);
	erase_character(5);
	move_vertical(1);
endloop;
erase_line;
position(beginning_of(keypad_buffer));
endprocedure

!                                                                       Page 19
!+
! This is bound to the ^Z key. It will read a line and parse it, looking
! for the first thing to be one of the line mode commands it can
! interpret.
!-
procedure edt$Line_mode(command_mode)		!ctrl z (line mode)

LOCAL		command_name ,
		command_status ,
		command_index ,
		WIN, TEMP1, BUF,
		term_char;
if edt$x_commands = 0
then
!+
! initialize some global variables needed by the line mode parser
!-
edt$x_range_length := 7;
edt$x_make_buf_var := 'new';
!		   1          2          3          4          5
edt$x_commands :=' ?          =          CHANGE     CLEAR      EXIT      '
		+' HELP       INCLUDE    QUIT       RESET      SUBSTITUTE'
		+' SET        SHOW       TYPE       TPU        WRITE     '
		+' EDIT       DELETE     COPY       MOVE       ';
edt$x_command_length := 11;
edt$x_ranges := ' =      SELECT WHOLE  REST   BEFORE LINE   BEGIN';
edt$x_selects := ' NONE    BOLD    BLINK   REVERSE UNDERLINE';
edt$x_searches := ' GENERAL EXACT   BEGIN   END     STRING  '+
		   'NONE    BOLD    BLINK   REVERSE UNDERLINE';
edt$x_searches_length := 8;
edt$x_sets := ' CURSOR PROMPT SCREEN SEARCH SELECT TAB    VIDEO  WRAP   ';
edt$x_set_length := 7;
endif;

!+
! Keep looping until we see something that will cause us to exit.
! Right now this is only the Change command
!-
loop
    if command_mode = 0 then
        edt$x_line := read_line('*');	! Ctrl_z entry
    else
	edt$x_line := command_mode;	! Single command desired
    endif;
!
!	What command is it?
!
    edit(edt$x_line,trim);		! Trim off excess chars
    exitif edt$x_line = edt$x_empty;	! Exit on blank line
    command_name := edt$next_token(edt$x_nonalpha,term_char);
    command_index := index(edt$x_commands,(' '+ command_name));
    command_index := ((command_index + edt$x_command_length)-1) / edt$x_command_length;

    CASE command_index FROM 0 TO 19

    [0]:
         message('Illegal command "'+command_name +'"') ;
    [1]:
	command_name := 'Commands:'+edt$x_commands;
	edt$message(command_name);
    [2]:
    	command_status := edt$buffer(edt$x_empty);
	update(current_window);
    [3]:
	if edt$x_line <> edt$x_empty then;	! More on line ?
	    message('Extraneous characters following valid command:"'+edt$x_line+'"');
	endif;
	exitif;					! No change back to keypad mode
    [4]:			! Clear command
	command_status := edt$clear;
    [5]:
	edt$x_line := term_char+edt$x_line;
	command_status := edt$exit;
    [6]:
	if (edt$x_line = edt$x_empty)
	then
	    edt$help ('EDT_EM HELP');
	else
	    edt$help ('EDT_EM LINE_MODE ' + edt$x_line);
	endif;
    [7]:
    	command_status := edt$include;
        update(current_window);
    [8]:
	edt$x_line := term_char+edt$x_line;
	command_status := edt$quit;
    [9]:			! Reset command
!
!	Delete all windows
!
	WIN := get_info(windows,'first');
	loop
	    exitif win = 0;				! All done ?
	    If get_info(win,'visible') then;
		unmap(win);
		WIN := get_info(windows,'first');
	    else;
		win := get_info(windows,'next');
	    endif;
	endloop;
!	remap main + message windows
	map(message_window,message_buffer);
	map(main_window,main_buffer);
	edt$reset;
	edt$refresh;
!
!	Delete all markers
!
	BUF := get_info(buffers,'first');
	loop;
	    exitif buf=0;
	    TEMP1 := 0;
	    loop
		WIN := get_info(current_buffer,'first_marker');
		exitif win = 0;				! All done ?
		TEMP1 := TEMP1+1;
		delete(win);
	    endloop;
	    if TEMP1 <> 0 THEN MESSAGE(STR(TEMP1)+' Markers deleted'); endif;
!
!	Delete all ranges
!
	    TEMP1 := 0;
	    loop
		WIN := get_info(current_buffer,'first_range');
		exitif win = 0;				! All done ?
		TEMP1 := TEMP1+1;
		delete(win);
	    endloop;
	    if TEMP1 <> 0 THEN MESSAGE(STR(TEMP1)+' ranges deleted'); endif;
	    BUF := get_info(buffers,'next');
	endloop;
	
    [10]:
	edt$x_line := term_char+edt$x_line;
	command_status := edt$line_mode_substitute;
	update(current_window);

    [11]:
    	command_status := edt$set;
    [12]:
	command_status := edt$show;
    [13]:
	edt$x_line := term_char+edt$x_line;
	command_status := edt$type;
    [14]:			! Tpu command
   	edt$command(edt$x_line);	
	edt$x_line := edt$x_empty;
    [15]:
    	command_status := edt$write
    [16]:
	edt$edit;		! Edit command
    [17]:
	command_status := edt$delete;
    [18]:
	command_status := edt$line_mode_copy(false);
    [19]:
	command_status := edt$line_mode_copy(true);
    ENDCASE;
    loop;
	edit(edt$x_line,trim);	! Trim off extra chars
	exitif index(edt$x_line,'?') <> 1;	! Not leading '?' ?
	edt$x_line := substr(edt$x_line,2,length(edt$x_line));
    endloop;
    if edt$x_line <> edt$x_empty then;	! More on line ?
	message('Extraneous characters following valid command:"'+edt$x_line+'"');
    endif;
    exitif command_mode <> 0;
    update(current_window);
endloop;
endprocedure
procedure edt$message(message_text)
    local	curr_string,
		message_string,
		c , c_end,
		curr_width;
    curr_width := get_info(screen,"width");
    message_string := message_text;
    c := 1;						! First character
  loop
    edit (message_string,trim,compress);
    exitif length(message_string) = 0;			! All done ?
    if length(message_string) > curr_width then;	! String too long ?
	c := curr_width;				! Start at end
	loop;
	    if c <= 0 then;
		c := curr_width;
		exitif;
	    endif;
	    exitif substr(message_string,c,1) = ' ';	! Found blank ?
	    c := c-1;					! Next char
	endloop;
    else;
	c := length(message_string);
    endif;
    curr_string := substr(message_string,1,c);
    message_string := substr(message_string,c+1,length(message_string));
    message(curr_string);
  endloop;
endprocedure

!                                                                       Page 20
!
!+
! Line mode command parser. This will return the next token from the line.
!
!  edt$x_line -  what is left of the  current line mode command
!-
procedure edt$next_Token ( additional_terms , term_char) !support routine for line mode
LOCAL	   	line_length ,! Length of line
		terminators ,! Token terminators
		cp ,! Current pointer into line
		sp ,! Saved pointer into the line
		char ,! Current character
		quoted ,! True if in a quoted string
		curr_line,	! Save current line
		token ;          ! Token to return
terminators := edt$x_terminators + additional_terms;
edit(edt$x_line,trim);
curr_line :=edt$x_line;			! Save input line
change_case(curr_line,upper);		! Make it all upper case
line_length := length(edt$x_line);
term_char := edt$x_empty;
If (line_length = 0)
then
    RETURN edt$x_empty;
endif;
!
! Did we find =,   as in =buffer
!
char := substr(curr_line,1,1);
if (char  = '=')
then
    edt$x_line := substr(edt$x_line,2,line_length);
    term_char := '=';
    return '=';
endif;
!
! look for the end of the thing we are on.
!
! See if the thing we found is a terminator. If so, just
! return that.
if (index(terminators,char) <> 0)
then
    term_char := char;
    edt$x_line := substr(edt$x_line,2,line_length);
    return edt$x_empty;
endif;
cp := 2;
quoted := 0;
loop
    exitif cp > line_length;
    char := substr(curr_line,cp,1);
    exitif (index(terminators,char) <> 0) and (quoted = 0);
    if char = '"' then quoted := 1-quoted; endif;
    cp := cp + 1;
endloop;
if (index(terminators,char) <> 0) then;
    term_char := char;
else;
    term_char := edt$x_empty;
endif;
token := substr(edt$x_line,1,(cp - 1));
edt$x_line := substr(edt$x_line,(cp+1),line_length);
change_case(token,upper);		! Make it all upper case
return token;
endprocedure

!                                                                       Page 21
!+
! Find the buffer by name
!-
procedure edt$find_buffer ( buffer_name) ! support routine for line mode
LOCAL		upcased_name ,
	 	buffer_ptr ;
upcased_name := buffer_name;
change_case(upcased_name,upper);
buffer_ptr := get_info(buffers,'first');
loop
	exitif buffer_ptr = 0;
	exitif upcased_name = get_info(buffer_ptr,'name');
	buffer_ptr := get_info(buffers,'next');
endloop;
return buffer_ptr;
endprocedure


!+
! Process a range specifier. We will return either a range or a buffer.
!-
procedure edt$range_specification ( range_spec ) ! support routine for line mode
LOCAL		M1,save_mark,r_index ;
!+
! What did they give us
!-
spec := range_spec;
if (spec = edt$x_empty) and edt$x_prompt then; spec := '?'; endif;
loop;
    exitif spec <> '?';
    spec := read_line('  Range specification:');	
    edit (spec,trim,upper);
    if spec = edt$x_empty then; return 0; endif;
    exitif spec <> '?';
    edt$message('Options:? '+edt$x_ranges)
endloop;
r_index := index(edt$x_ranges,(' '+spec));
r_index := ( (r_index +  edt$x_range_length - 1) / edt$x_range_length);
CASE r_index from 0 TO 7
[0]:
[1]:
    r_index := edt$buffer(edt$x_empty);
    return r_index;
[2]:
!	SELECT
     edt$select_range;
     if (edt$x_select_range = 0)
     then
	message("No Select Active");
	return 0;
     else
	return edt$x_select_range;
     endif;

[3]:
!	WHOLE
    r_index := current_buffer;
    return r_index;
[4]:
!	REST
    r_index := create_range(mark(none),end_of(current_buffer),none);
    return r_index;
[5]:
!	BEFORE
    r_index := create_range(beginning_of(current_buffer),mark(none),none);
    return r_index;
[6]:
!	LINE
    SAVE_MARK := mark(none);
    if (current_offset <> 0) then move_horizontal(-current_offset) endif;
    m1:=mark(none);
    move_horizontal(length(current_line));
    r_index:=create_range(m1,mark(none),none);
    position(save_mark);
    return r_index;
[7]: ! BEGIN
    position(beginning_of(current_buffer));
    m1:=mark(none);
    if m1 = end_of(current_buffer) then;	! At end of buffer ?
	return current_buffer;
    endif;
    Move_vertical(1);
    r_index:=create_range(m1,mark(none),none);
    position(save_mark);
    return r_index;
ENDCASE;

message('Unsupported range specification: "' + spec+'"');
return 0;
endprocedure

!                                                                       Page 22
!+
! Process the line mode =buffer command
!-
procedure edt$buffer(file_name)  ! support routine for line mode(= buffer cmd)

LOCAL	buffer_ptr ,
	curr_window,
	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.
edt$x_current_column := 0;		! No current column number
loop;
    buffer_name := edt$next_token('/',term_char);
    exitif buffer_name <> '=';
endloop;
if term_char = '/' then; edt$x_line := '/'+edt$x_line; endif;
if (buffer_name = edt$x_empty) or (buffer_name = '?') then
    if (edt$x_prompt) or (buffer_name = '?') then;
	loop;
	    buffer_name := read_line('  Buffer name:');	
	    edit (buffer_name,trim,upper);
	    if buffer_name = edt$x_empty then; return 0; endif;
	    exitif buffer_name <> '?';
	    edt$show_buffer;
	endloop;
    else;
	message('Missing buffer name');
	return 0;
    endif;
endif;
! IF it exists just map to it.
buffer_ptr := edt$find_buffer(buffer_name);
if buffer_ptr = 0 then			! No buffer ?
	edt$x_make_buf_var := buffer_name;
	create_variable_string := edt$x_make_buf_var +
		"_buffer := create_buffer(edt$x_make_buf_var,"""+
		file_name+""")";
        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+']');
	map(current_window,buffer_ptr);
else;
	map(current_window,buffer_ptr);
	IF file_name <> edt$x_empty then
		read_file(file_name);
	endif;
endif;
!
!	fix for bad message routine
!
    curr_window := current_window;
    position(message_window);
    position(end_of(current_buffer));
    update(current_window);
    position(curr_window);
return buffer_ptr;
endprocedure

!                                                                       Page 23
!+
! EDT line mode Show command
!-
procedure edt$show		! support routine for line mode(show cmd)

LOCAL		show_type ,
		input_name,
		output_name,
		buf ,
		cur_buf,
		pos ,
		term_char ,
		save_info_status,
		mark1,mark2,mark3,mark4,
		show_index ;
!+
! What do they want to know
!-
edt$x_shows :=  ' BUFFER  CURSOR  PROMPT  SCREEN  SEARCH  SELECT  VERSION'+
		' VIDEO   WRAP    ';
edt$x_show_length := 8;
show_index := edt$prompt_index('Show Option',edt$x_shows,edt$x_show_length);

CASE show_index FROM 0 TO 9
[0]:
    return 0;
[1]:
! SHOW BUFFER
    edt$show_buffer;
[2]:
! SHOW CURSOR
    buf := 'Cursor boundaries are  ';
    buf :=  buf + str((get_info(current_window,'scroll_top')));
    buf := buf + ':';
    buf :=  buf + str((get_info(current_window,'visible_length') -
		2 - get_info(current_window,'scroll_bottom')));
    message(buf);

[3]:
! SHOW PROMPT
    if edt$x_prompt then;
	message('Prompt: ON')
    else;
	message('Prompt: OFF')
    endif;
[4]:
! SHOW SCREEN
    buf := 'Screen Width is ';
    buf := buf + str(get_info(current_window,'width'));
    message(buf);

[5]:
! SHOW SEARCH
    buf := 'Search settings: ';
    if (edt$x_search_begin)
    then
	buf := buf + 'BEGIN '
    else
	buf := buf + 'END   '
    endif;
    if (edt$x_search_case = exact)
    then
	buf := buf + 'EXACT   '
    else
	buf := buf + 'GENERAL '
    endif;
	buf := buf + edt$video_string(edt$x_search_video);
    message(buf);
    if edt$x_search_string <> edt$x_empty then;
	message('String: '+edt$x_search_string );
    endif;
[6]:
! SHOW SELECT
    buf := 'Select mode: '+ edt$video_string(edt$x_select_video);
    message(buf);
[7]:
! SHOW VERSION
    message(edt$x_version);

[8]:
! SHOW VIDEO
    buf := 'Video mode for the current window: '+
	edt$video_string(get_info(current_window,"video"));
    message(buf);
[9]:
! SHOW WRAP
    IF (edt$x_wrap_position = 0)
    then
	message ('Nowrap');
    else
        message('Wrap setting: ' + str (edt$x_wrap_position));
    endif;
ENDCASE;
endprocedure
procedure edt$video_string(video_key);
    if video_key = reverse then; return "REVERSE "; endif;
    if video_key = UNDERLINE then; return "UNDERLINE "; endif;
    if video_key = BOLD then; return "BOLD "; endif;
    if video_key = BLINK then; return "BLINK "; endif;
    return "NONE";
endprocedure
procedure edt$show_buffer
LOCAL	show_type ,
	curr_length,
	temp_str,
	input_name,
	output_name,
	buf ,
	cur_buf,
	pos ,
	term_char ,
	save_info_status,
	mark1,mark2,mark3,mark4,
	show_index ;
    pos := current_window;
    cur_buf := current_buffer;
    erase(show_buffer);
    position(show_buffer);
    copy_text(' Buffer name	Lines	Type	File name');
    split_line;
    move_horizontal(-1);
    mark1 := create_range(beginning_of(current_buffer),mark(none),underline);
    buf := get_info(buffers,'first');
    move_horizontal(1);
    set(status_line,info_window,reverse,' ');
    set(width,info_window,get_info(screen,'width'));
    map(info_window,show_buffer);
    curr_length := get_info(info_window,"original_length")-4;
    loop
	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
	If get_info(buf,'no_write') then
		copy_text('Ref:');
	else
		copy_text('Write:');
	endif;
	copy_text('	');              ! insert a tab
	input_name := get_info(buf,'file_name');
	copy_text(input_name);
	output_name := get_info(buf,"output_file");
	if output_name <> 0 then;
		if output_name <> input_name then;
			curr_length := curr_length-1;
			split_line;
			copy_text('		');	! insert 2 tabs
			copy_text('Out:');
			copy_text('	');      	! insert a tab
			copy_text(output_name);
		endif;
	endif;
	buf := get_info(buffers,'next');
	exitif buf = 0;
	curr_length := curr_length-1;
	if curr_length <= 0 then;
	    curr_length := get_info(info_window,"original_length")-2;
	    update(info_window);
	    temp_str := read_line('Press RETURN to continue.',1);
	endif;
	split_line;
    endloop;
    update(info_window);
    temp_str := read_line('Press RETURN to continue.',1);
    unmap(info_window);
    position(pos);
endprocedure

!                                                                       Page 24
!
procedure edt$prompt_index(prompt,options,nchar)
    local temp_str,term_char,command_name,command_index;
    command_name := edt$next_token(edt$x_nonalpha,term_char);
    edt$x_line := term_char+edt$x_line;		! Keep terminator
    if command_name = edt$x_empty then;
	if (edt$x_prompt) or (term_char = '?') then;
	    If term_char = '?' then;
		edt$x_line := substr(edt$x_line,2,length(edt$x_line));
	    endif;
	    loop;
		edt$x_line := read_line('  '+prompt+':')+' '+edt$x_line;
		command_name := edt$next_token(edt$x_nonalpha,term_char);
		if command_name = edt$x_empty then;
		    if term_char = '?' then;
			temp_str := 'Options:?'+options;	! Type out options
			edt$message(temp_str);		! To help user
			edt$x_line := substr(edt$x_line,2,length(edt$x_line));
		    else;  return edt$x_empty;
		    endif;
		else;
		    exitif;
		endif;
	    endloop;
	else;
	    message('Missing '+prompt);
	    return edt$x_empty;
	endif;
    endif;
    command_index := index(options,(' '+ command_name));
    command_index := (command_index + nchar-1) / nchar;
    if command_index = 0 then;
	message ('Illegal '+prompt+' "'+command_name+'"')
    endif;
    return command_index;
endprocedure
procedure edt$prompt_token(prompt)
    local term_char,command_name;
    command_name := edt$next_token(edt$x_empty,term_char);
    if (command_name = edt$x_empty) or (command_name = '?') then;
	if (edt$x_prompt) or (command_name = '?') then;
	    loop;
		edt$x_line := read_line('  '+prompt+':')+' '+edt$x_line;
		command_name := edt$next_token(edt$x_empty,term_char);
		exitif command_name <> '?';
	    endloop;
	else;
	    message('Missing '+prompt);
	endif;
    endif;
return command_name;
endprocedure
!+
! Edt line mode SET command
!-
procedure edt$set	!support routine for line mode(set cmd)
LOCAL
    set_index ,
    temp_value1,
    temp_value2,
    temp_value3,
    term_char ,
    curr_W,
    set_type ;
!+
! What are we setting?
!-
set_index := edt$prompt_index('Set Option',edt$x_sets,edt$x_set_length);
CASE set_index FROM 0 to 8
[0]:
    return 0;

[1]:
! SET CURSOR
    temp_value3 := get_info(current_window,'visible_length')-2;
    temp_value3 := str(temp_value3);
    set_type := edt$next_token(':',term_char);
    if (set_type = edt$x_empty) or (set_type = '?') then;
	if (edt$x_prompt) or (set_type = '?')  then;
	  loop;
	    if set_type = '?' then;
		message('Enter Distance from top of current window'); endif;
	    edt$x_line := 
		read_line('  Top scrolling limit (0-'+temp_value3+'):')+
		edt$x_line;
	    set_type := edt$next_token(':',term_char);
	    if set_type = edt$x_empty then; return 0; endif;
	    exitif set_type <> '?';
	  endloop;
	else;
	    message('Missing top scroll limit (current_window)');
	    return 0;
	endif;
    endif;
    temp_value1 := int(set_type);
    set_index := str(temp_value1);
    set_type := edt$next_token(':',term_char);
    if (set_type = edt$x_empty) or (set_type = '?') then;
	if (edt$x_prompt) or (set_type = '?')  then;
	  loop;
	    if set_type = '?' then;
		message('Enter Distance from top of current window'); endif;
	    set_type := read_line('  Bottom scrolling limit('+
		set_index+'-'+temp_value3+'):');
	    edit(set_type,trim);
	    if set_type = edt$x_empty then; return 0; endif;
	    exitif set_type <> '?';
	  endloop;
	else;
	    message('Missing bottom scrolling limit (current_window)');
	    return 0;
	endif;
    endif;
    temp_value2 := int(set_type)+2;
    temp_value2 := get_info(current_window,'visible_length') - temp_value2;
    set(scrolling,current_window,ON,temp_value1,temp_value2,0);
[2]:	! SET PROMPT
    set_index := edt$prompt_index('Prompt',' ON OFF',3);
    case set_index from 0 to 2
    [0]:  return 0;
    [1]:  edt$x_prompt := true;
    [2]:  edt$x_prompt := false;
    ENDCASE;
[3]:
! SET SCREEN
    set_type := edt$prompt_token('Screen width (20-255)');
    if (set_type = edt$x_empty) then; return 0; endif;
    temp_value1 := int(set_type);
    if (temp_value1 < 20) or (temp_value1 > 255) then;
	message('Illegal width (20-255) "'+set_type+'"');
	return 0
    endif;
    curr_w:=get_info(WINDOWS,"first");     ! Get first window
    loop
	set(width,curr_W,temp_value1);
	curr_w:=get_info(WINDOWS,"next");     ! Get next window
	exitif curr_W = 0
    endloop;
    update(message_window);

[4]:
! SET SEARCH
    loop
	set_index := edt$prompt_index('SEARCH option',edt$x_searches,
		edt$x_searches_length);
	CASE set_index FROM 0 to 10
	[0]:
	    return 0;
	[1]:
! SET SEARCH GENERAL
	    edt$x_search_case := no_exact;
	[2]:
! SET SEARCH EXACT
	    edt$x_search_case := exact;

	[3]:
!SET SEARCH BEGIN
	    edt$x_search_begin := 1;

	[4]:
! SET SEARCH END
	    edt$x_search_begin := 0;
	[5]:
! SET SEARCH STRING
	    edit(edt$x_line,trim);
	    if (edt$X_line = edt$x_empty) or (edt$x_line = '?')  then	! No string ?
		if (edt$x_prompt) or (edt$x_line = '?')  then;
		    loop;
			edt$x_line :=read_line('  Search string:');
			edit(edt$x_line,trim);
			if edt$X_line = edt$x_empty then; return 0; endif;	! No string ?
			exitif edt$x_line <> '?';
		     message('ENTER: "string" () & | line_begin line_end ...');
		    endloop;
		else;
		    message('Missing search string');
		    return 0;
		endif;
	    endif;
	    edt$x_search_string := edt$x_line;		! String to search for
	    edt$x_line := edt$x_empty;
	    execute("edt$x_search_pattern :="+edt$x_search_string);
	[6]:
	    edt$x_search_range := 0;
	    edt$x_search_video := 0;
	[7]:
	    edt$x_search_range := 0;
	    edt$x_search_video := bold;
	[8]:
	    edt$x_search_range := 0;
	    edt$x_search_video := blink;
	[9]:
	    edt$x_search_range := 0;
	    edt$x_search_video := reverse;
	[10]:
	    edt$x_search_range := 0;
	    edt$x_search_video := underline;
	ENDCASE;
        exitif edt$x_line = edt$x_empty;
    endloop;
[5]:
! SET SELECT
    set_index := edt$prompt_index('Select mode',edt$x_selects,8);
    CASE set_index FROM 0 to 5
    [0]:
	return 0;
    [1]:
	edt$x_search_range := 0;
	edt$x_select_video := NONE;
    [2]:
	edt$x_search_range := 0;
	edt$x_select_video := bold;
    [3]:
	edt$x_search_range := 0;
	edt$x_select_video := blink;
    [4]:
	edt$x_search_range := 0;
	edt$x_select_video := reverse;
    [5]:
	edt$x_search_range := 0;
	edt$x_select_video := underline;
    ENDCASE;
[6]:
! SET TAB
    set_type := edt$prompt_token('First tab location (1-255)');
    if (set_type = edt$x_empty) then; return 0; endif;
    temp_value1 := int(set_type);
    if (temp_value1 > 255) OR ( temp_value1< 0 )
      then message('Illegal tab value (1-255) "'+set_type+'"')
    else
     edt$x_tab_size := temp_value1;
     edt$x_tab_goal := edt$x_tab_size;
     edt$x_tabs_set := 1;
    endif;

[7]:
! SET VIDEO
    set_index := edt$prompt_index('Video mode',edt$x_selects,8);
    CASE set_index FROM 0 to 5
    [0]:
	return 0;
    [1]:
	SET(VIDEO,current_window,NONE);
    [2]:
	SET(VIDEO,current_window,bold);
    [3]:
	SET(VIDEO,current_window,blink);
    [4]:
	SET(VIDEO,current_window,reverse);
    [5]:
	SET(VIDEO,current_window,underline);
    ENDCASE;
[8]:
! SET WRAP
    set_type := edt$prompt_token('Length of line (1-255)');
    if (set_type = edt$x_empty) then; return 0; endif;
    temp_value1 := int(set_type);
    if (temp_value1 > 255) OR ( temp_value1< 1 )
      then message('Illegal wrap value (1-255) "'+set_type+'"');
	   return 0
    endif;

    if (temp_value1 = 0)
    then
	if (edt$x_wrap_position <> 0)
	then
	    undefine_key(key_name(' '));
	endif;
    else
	if (edt$x_wrap_position = 0)
	then
	    define_key('edt$wrap_word',key_name(' '));
	endif;
    endif;
edt$x_wrap_position := temp_value1;


ENDCASE;
return 1;
endprocedure


procedure edt$type
    local line_count,curr_line,current_error,command_name,line_number,term_char;
    on_error;
	if command_name = edt$x_empty then;
	    message(' Line: '+str(line_number));
	    position(curr_line);
	    return 1;
	endif;
    endon_error;
    command_name := edt$next_token(edt$x_nonnumeric,term_char);
    edt$x_current_column := 0;			! No current column number
    move_horizontal(-current_offset);
    if command_name <> edt$x_empty then;	! Line number ?
	line_count := INT(command_name);	! Get count
	if line_count = 0 then;
	    message('Illegal line count: "'+command_name+'"');
	endif;
	if index('+-',substr(command_name,1,1)) = 0 then;
		position(beginning_of(current_buffer));
		line_count := line_count-1;
	endif;
	move_vertical(line_count);
    endif;
    command_name := edt$x_empty;
    line_number := 0;				! will be line number
    curr_line:= mark(none);
    if curr_line = beginning_of(current_buffer) then;
	message(' Line: 1');
	return 1;
    endif;
    if curr_line = end_of(current_buffer) then;
	message(' Line: '+str(1+get_info(current_buffer,"record_count")));
	return 1;
    endif;
    loop
	line_number:= line_number+1;
	move_vertical(-1);
    endloop;
endprocedure


procedure edt$clear
!
!	Clear the requested buffer
!
    local buffer_name,buffer_ptr,term_char;
    buffer_name := edt$prompt_token('Buffer to clear');
    if (buffer_name = edt$x_empty) then; return 0; endif;
    buffer_ptr := edt$find_buffer (buffer_name);
    if (buffer_ptr = 0)
    then
	message ('Buffer "'+buffer_name+'" does not exist');
	return 0;
    else
    message (str(get_info(buffer_ptr,'record_count'))+' lines deleted from '+
	get_info(buffer_ptr,'name')+' buffer');
    erase(buffer_ptr);
    if not get_info(buffer_ptr,'system') then;
	map(current_window,main_buffer);
	delete(buffer_ptr);
    endif;
    return 1;
    endif;
endprocedure;


procedure edt$delete
    local term_char,range_spec,command_name;
    if edt$x_line = edt$x_empty then; edt$x_line := 'LINE'; endif;
    command_name := edt$next_token(edt$x_empty,term_char);
    range_spec :=edt$range_specification(command_name);
    if range_spec = 0 then; RETURN 0; endif;
    erase(range_spec);
ENDPROCEDURE


procedure edt$line_mode_copy(Move_param)
    local
	term_char,
	mark1,
	from_range,
	to_range,
	command_name,
	command_index;
    mark1 := mark(none);		! Current location
    command_name := edt$next_token(edt$x_empty,term_char);
    from_range :=edt$range_specification(command_name);
    if from_range = 0 then; RETURN 0; endif;
    position(mark1);			! Restore initial position
    if	(substr(edt$x_line,1,1) <> '?') and
	((edt$x_line <> edt$x_empty) or (not edt$x_prompt)) then;
	command_name := edt$next_token(edt$x_empty,term_char);
	if command_name <> 'TO' then;
	    message('Illegal keyword "'+command_name+'" "TO" expected');
	    return 0;
	endif;
    endif;
    if (edt$x_line = edt$x_empty) and (not edt$x_prompt) then;
	edt$x_line:='LINE';	! Default
    endif;
    command_index := edt$prompt_index('To',' =    LINE END  BEGIN',5);
    case command_index from 0 to 4
    [0]:
	return 0;
    [1]:
	to_range := edt$buffer(edt$x_empty);
	if to_range = 0 then; return 0; endif;
    [2]:
	to_range := mark1;
    [3]:
	to_range :=end_of(current_buffer);
    [4]:
	to_range :=beginning_of(current_buffer);
    endcase;
    position(to_range);
    move_horizontal(-current_offset);
!    if mark(none) = end_of(current_buffer) then; move_horizontal(-1); endif;
    to_range := mark(none);
!
!	Check if To range is inside From range
!
    if get_info(end_of(from_range),"buffer") = get_info(to_range,"buffer") then;
	if (to_range >= beginning_of(From_range)) and
    	   (to_range <= end_of(From_range)) then;
	    message ('To_range inside From_range in COPY or MOVE');
	    return 0
	endif;
    endif;
    if move_param then;				! Move ?
	move_text(from_range);			! Move
    else;
	copy_text(from_range);			! copy
    endif;
    map(current_window,current_buffer);		! Set up current window
    edt$x_select_range := 0;			! Remove select
ENDPROCEDURE


!                                                                       Page 25
!+
! Edt line mode Write command
!-
procedure edt$write  ! support routine for line mode(write cmd)

LOCAL		file_name ,
		buffer_ptr,
		buffer_name,
		range_specifier ,
		term_char ,
		text_to_write ;
!+
! Is there isn't a file name, just write the buffer
!-
file_name := edt$next_token(edt$x_empty,term_char);
if (edt$x_prompt) and (file_name = edt$x_empty) then; file_name := '?'; endif;
loop;
    exitif (file_name = edt$x_empty);
    exitif file_name <> '?';
    file_name := read_line('  File_name to write:');
    edit(file_name,trim,upper);
    if (file_name = '/') then; return 0; endif;
    edt$Message('Default:write current buffer to current file.');
    edt$Message('Enter file name or / exits from command');
endloop;
if (file_name = edt$x_empty) then
    write_file(current_buffer);
    return 1;
endif;
!+
! Now check for what to write.
!-
range_specifier := edt$next_token(edt$x_empty,term_char);
if (edt$x_prompt) or (range_specifier <> edt$x_empty) then;
    text_to_write := edt$RANGE_specification(range_specifier);
endif;
if (text_to_write = edt$x_empty) then; text_to_write := current_buffer; 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.
!-
edt$x_select_range := 0;
return 1;
endprocedure

!                                                                       Page 26
!+
! Edt line mode INCLUDE command
!
!-
procedure edt$include ! support routine for line mode(include cmd)

LOCAL	file_name ,
	write_opt,
	equal_option ,
	cur_buf,
	option,
	buff_stat,
	term_char ;
!+
! Get the file  name
!-
edt$x_current_column := 0;		! No current column number
file_name := edt$prompt_token('File name');
if (file_name = edt$x_empty) then; return 0; endif;
file_name := file_parse(file_name,';0',get_info(main_buffer,'file_name'));
!+
! Now we look for the optional BUFFER. We are only going to support
! one particular option. That of specifying a buffer for the file
! to go into
!-
equal_option := edt$next_token(edt$x_empty,term_char);
if (equal_option = edt$x_empty) then	! No buffer specified ?
!
!	Now read the file in
!
    read_file(file_name);
    write_opt := false;
else;
!
! It had better be the = command
!
    if (equal_option <> '=') then
	message('Unsupported option on INCLUDE, RANGE can only be =buffer');
	edt$x_line := edt$x_none;
	return 0;
    else
	if (edt$buffer(file_name) = 0)
	then
	    edt$x_line := edt$x_none;
	    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
	write_opt := get_info(current_buffer,"NO_write");
	option := edt$next_token(edt$x_empty,term_char);
	If option <> edt$x_empty then;
	    IF index(" /WRITE",' '+option) = 0 THEN
		message('Illegal option "'+option+'"');
	    else;
		write_opt := false;
		set (no_write,current_buffer,off);
	    endif;
	ENDIF;
	if (write_opt) and (edt$x_prompt) then;
	    if edt$read_Y_N('  Write file ?') then;
		set (no_write,current_buffer,off);
		write_opt := false;
	    endif;
	endif;
    endif;
endif;
if write_opt then
    message('Buffer '+get_info(current_buffer,"NAME")+
	' will not be written on EXIT');
endif;
return 1;
endprocedure
procedure edt$read_Y_N(prompt);
loop;
    option := read_line(prompt+' (Y or N) :');
	edit(option,trim,upper);
	option := substr(option,1,1);
	if option = 'Y' THEN; return true;  endif;
	if option = 'N' THEN; return false; endif;
endloop;
endprocedure

!                                                                       Page 27
!+
! EDT line mode QUIT Command
!-
procedure edt$quit 		! support routine for line mode(quit cmd)
LOCAL	term_char ,
	 save_opt ;
on_error
! If an error occurs here stop the EXIT
if error <> tpu$_nojournal
then
    return 0;
endif;
endon_error;
save_opt := edt$next_token('',term_char);
if (save_OPT <> edt$x_empty)
then
    if (index('/SAVE',save_opt) <> 1)
    then
	message('Unsupported QUIT option');
	return 0;
    else
	journal_close;
    endif;
endif;
quit;
return 0;
endprocedure

!+
! Edt line mode EXIT command
!_
procedure edt$exit 		!support routine for line mode(exit cmd)
LOCAL	term_char ,
	temp_str;
on_error
! If an error occurs here stop the EXIT
if error <> tpu$_nojournal
then
    return 0;
endif;
endon_error;
loop;
    temp_str := edt$next_Token('/',term_char);
    exitif (temp_str = edt$x_empty) and (term_char = edt$x_empty);
    if (temp_str <> edt$x_empty) then; 
	set(output_file,main_buffer,temp_str);
	set(no_write,main_buffer,off);
    endif;
    if (term_char = '/') then
!	I must have picked up SAVE
	temp_str := edt$next_token('/',term_char);
	    edt$x_line := term_char+edt$x_line;
	if (index('SAVE',temp_str) <> 1)
	then
	    message('Illegal EXIT option');
	    return 0;
	else;
	    journal_close;
	endif;
    endif;
endloop;
if (get_info(main_buffer,'No_write')) and
   (get_info(main_buffer,'modified')) then
    loop;
	temp_str := read_line('  MAIN File name:');
	edit (temp_str,trim);
	if temp_str = edt$x_empty then; return 0; endif;
	if temp_str <> '?' then;
	    set(output_file,main_buffer,temp_str);
	    set(no_write,main_buffer,off);
	    exitif;
	endif;
	edt$message('Filename for saving the MAIN buffer, "Return"');
    endloop;
endif;
exit;
endprocedure
!+
! Edt line mode EXIT command
!_
procedure edt$edit 		!support routine for line mode(exit cmd)
LOCAL	term_char ,
	buf ,
	win ,
	term_char ,
	temp_str;
!
!	If main window changed and no filename get filename
!
    if (get_info(main_buffer,'No_write')) and
       (get_info(main_buffer,'modified')) then
	loop;
	    temp_str := read_line('  MAIN output File name:');
	    edit (temp_str,trim);
	    if temp_str = edt$x_empty then; return 0; endif;
	    exitif temp_str <> '?';
	    message('File name to save MAIN buffer, or "Return"');
	endloop;
	set(output_file,main_buffer,temp_str);
	set(no_write,main_buffer,off);
    endif;
!
!	Delete all windows
!
    WIN := get_info(windows,'first');
    loop
	exitif win = 0;				! All done ?
	If get_info(win,'visible') then;
		unmap(win);
		WIN := get_info(windows,'first');
	else;
		win := get_info(windows,'next');
	endif;
    endloop;
!	remap main + message windows
    map(message_window,message_buffer);
    map(main_window,main_buffer);
!
!	Write and clear all buffers
!
    buf := get_info(buffers,'first');
    loop
	exitif buf = 0;
	If (get_info(buf,'no_write') = 0) and
	   (get_info(buf,'modified')) then
		write_file(buf);
	endif;
	erase(buf);
	buf := get_info(buffers,'next');
    endloop;
!
!	Delete all non system buffers
!
    buf := get_info(buffers,'last');
    loop
	exitif buf = 0;				! Done ?
	If get_info(buf,'system') then		! system buffer ?
	    buf := get_info(buffers,'previous');! Next buffer
	else;
	    delete(buf);			! Delete it
	    buf := get_info(buffers,'last');	! And start all over
	endif;
    endloop;
    Position(main_window);
    buf := edt$x_prompt;
    edt$x_prompt := true;
    loop;
	file_name := edt$prompt_token('New File to edit:');
	exitif file_name <> edt$x_empty;
	Message('You MUST enter a filename to edit, or ^Y to exit');
    endloop;
    edt$x_prompt :=buf;
    read_file(file_name);	
    set (output_file,main_buffer,file_name);
endprocedure

!                                                                       Page 28
!+
! EDT line mode SUBSTITUTE command
!-
procedure edt$line_mode_substitute ! support routine for line mode(subs cmd)
local
	cp,
	line_length,
	old_index,
	temp_mark,
	remaining_line,
	command_name,
	command_index,
	range_spec,
	term_char,
	old_term,
	count,
	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] [/log]
!		delimiter (edt$x_subs_term)
!		string to be replaced
!		delimiter (same as above)
!		new string
!		delimiter (same as above)
!		either 'whole' if from beginning to end of buffer
!		    or first occurrence in the current line
!
! Parse the rest of the line looking for old string and new string
!
if current_buffer = prompt_buffer then
    Message('Illegal buffer - PROMPT may not be used');
    edt$x_line := edt$x_empty;
    return 0
endif;
edit (edt$x_line, TRIM, OFF);
if (edt$x_line = edt$x_empty) and
   (edt$x_prompt) then; 
    edt$x_line := '?';
endif;
loop;
    edt$x_subs_term := substr (edt$x_line, 1, 1);
    exitif edt$x_subs_term <> '?';		! No Help required ?
    edt$x_line := read_line('  SUBSTITUTE options:');
    edit(edt$x_line,trim);
    if edt$x_line = edt$x_empty then; return 0;endif;
    edt$message('Enter: /oldstring/newstring/ [range] [/LOG] [/QUERY]')
endloop;
edt$x_line := substr (edt$x_line, 2, length (edt$x_line)-1);
if (index(edt$x_nonalpha,edt$x_subs_term) = 0) then
    message ('"'+edt$x_subs_term+ '" is an invalid delimiter for SUBSTITUTE');
    return 0;
endif;
edt$x_current_column := 0;		! No current column number
temp_mark := mark(none);		! Remember where we are
line_length := length (edt$x_line);
if (edt$find_sub_delimiter (line_length, cp) = 0)
then
    return 0;
endif;

old_string := substr (edt$x_line, 1, (cp - 1));
edt$x_line := substr (edt$x_line, (cp + 1), line_length);
line_length := length (edt$x_line);
if (edt$find_sub_delimiter (line_length, cp) = 0)
then
    return 0;
endif;

new_string := substr (edt$x_line, 1, (cp - 1));
edt$x_line := substr (edt$x_line, (cp + 1), line_length);
!
! See if range or /LOG was typed
!
range_spec := 0;
edt$x_search_log := false;
edt$x_search_query := false;
term_char := edt$x_empty;
loop;
    old_term := term_char;
    exitif edt$x_line = edt$x_empty;		! no more on line ?
    command_name := edt$next_token('/',term_char);
    if old_term = '/' then;			! option ?
        command_index := index(' LOG QUERY',' '+command_name);
	command_index := (command_index+3)/4;
	case command_index from 0 to 2
	[0]:
	    message('Illegal option "/'+command_name+'" in SUBSTITUTE');
	    return 0;
	[1]:
	    if current_buffer = show_buffer then
		Message('Illegal buffer - SHOW may not be used with /LOG');
		edt$x_line := edt$x_empty;
		return 0
	    endif;
	    edt$x_search_log := true;		! Turn logging on
	[2]:
	    edt$x_search_query := true;
	endcase;
    else;
	if command_name <> edt$x_empty then;
!
!		Get range spec
!
	   range_spec :=edt$range_specification(command_name);
	   if range_spec = 0 then; RETURN 0; endif;
	endif;
    endif;
endloop;
if range_spec = 0 then
    count := 1;					! Only do it once
    range_spec :=edt$range_specification("LINE");
    if range_spec = 0 then; RETURN 0; endif;
endif;
! Search through selected range and replace starting at the beginning
erase(prompt_buffer);			! Set up temporary buffer
position(prompt_buffer);		! go to temp buffer
split_line;
move_vertical(-1);
copy_text(range_spec);			! put text into it
position (beginning_of (current_buffer));
if edt$x_search_query then; map(current_window,current_buffer); endif;
edt$global_search_replace (old_string, new_string, count);
position(end_of(range_spec));		! Position at end of range
erase(range_spec);			! Now erase old text
move_text(prompt_buffer);		! put text back
append_line;				! Adjust blank line
position (temp_mark);
if edt$x_search_query then; map(current_window,current_buffer); endif;
return 1;
ENDPROCEDURE
!
! Find the next delimiter in the command line
!
PROCEDURE edt$find_sub_delimiter (line_length, cp) !support routine for subs cmd
cp := 1;
loop
if cp > line_length
then
    message ('Delimiter for SUBSTITUTE could not be found');
    RETURN 0;
endif;
exitif (substr(edt$x_line, cp, 1) = edt$x_subs_term);
cp := cp + 1;
endloop;
return 1;
ENDPROCEDURE

!                                                                       Page 29
PROCEDURE edt$global_search_replace (string1, string2, count) !support routine for subs cmd
!
! This procedure performs a search through the current
! buffer and replaces one string with another

LOCAL	command_name,
	command_index,
	curr_width,
	curr_shift,
	first_col,
	curr_col,
	test_query,
	test_line,
	old_line,
	new_line,
	msg_text,
	temp_range,
	src_range,
	replacement_count;

! Return to caller if string not found
ON_ERROR
    IF replacement_count=0 then;
	msg_text := '"'+string1+'" string not found'
    else;
	msg_text := FAO ('!UL  replacement!%S', replacement_count) + ' of "'
                    + string1 + '" with "' + string2 + '" in current buffer';
	if edt$x_search_log then;
	    msg_text := msg_text+' logged in SHOW buffer';
	endif;
    endif;
    MESSAGE (msg_text);
    RETURN 0;
ENDON_ERROR;

replacement_count := 0;

if edt$x_search_log then; erase(show_buffer); endif;	! prepare for subs.
test_line := true;
test_query := edt$x_search_query;
curr_width := get_info(screen,"width");
LOOP
    src_range := SEARCH (string1, forward,edt$x_search_case );  ! Search returns a range if found
    if edt$x_search_log then; old_line:=get_info(current_buffer,"line"); endif;
    if test_query then;
	temp_range := create_range(beginning_of(src_range),end_of(src_range),
			reverse);
	curr_shift := get_info(current_window,"shift_amount");
	POSITION (BEGINNING_OF (src_range));		! Move to right place
	first_col := get_info(current_buffer,"offset_column")-curr_shift;
	POSITION (END_OF (src_range));		! Move to right place
	curr_col := get_info(current_buffer,"offset_column")-curr_shift;
	if (curr_col > curr_width) or
	   (first_col < 0)             then;
		if first_col+curr_width > curr_col then
		    first_col := curr_col-curr_width+2;
		endif;
		shift(current_window,first_col);
	endif;
	update(current_window);
	loop;
	   command_name := read_line('Change ? (Y, N, Q, A): ',1);
	   change_case(command_name,upper);
	   command_index := index('YNQA',command_name);
	   case command_index from 0 to 4
	   [0]: message('Illegal input "'+command_name+'"');
	   [1]: test_line := true;  exitif;
	   [2]: test_line := false; exitif;
	   [3]: test_line := false; count :=replacement_count; exitif;
	   [4]: test_line := true; test_query := false; exitif;
	   endcase;
	endloop;
	temp_range := 0;
    endif;
    POSITION (END_OF (src_range));		! Move to right place
    if test_line then;				! Replace ?
	ERASE (src_range);			! Remove first string
	COPY_TEXT (string2);			! Replace with second string
	if edt$x_search_log then;
	    new_line:=get_info(current_buffer,"line");
	endif;
	replacement_count := replacement_count + 1;
	if edt$x_search_log then;
	   position(show_buffer);		! Put lines into show buffer
	   move_text("Old:"+old_line);		! Save old line
	   split_line;
	   move_text("New:"+new_line);		! Save old line
	   split_line;
	   POSITION (END_OF (src_range));	! Move to right place
	endif;
    else;
	move_horizontal(1);
    endif;
    exitif replacement_count = count;
ENDLOOP;
msg_text := FAO ('!UL  replacement!%S', replacement_count) + ' of "'
	+ string1 + '" with "' + string2 + '" in current buffer';
if edt$x_search_log then;
    msg_text := msg_text+' logged in SHOW buffer';
endif;
message(msg_text);
curr_shift := get_info(current_window,"shift_amount");
if curr_shift > 0 then;
    shift(current_window,-curr_shift);
endif;
RETURN 1;
ENDPROCEDURE

!                                                                       Page 30
!+
! EDT Move to the next word
!-
procedure edt$move_word		! kp2 (move word)
edt$x_current_column := 0;		! No current column number
if current_direction = forward
then
	edt$move_word_f
else		!moveback
	edt$move_word_r
endif
endprocedure			!moveword
!
! Move backwards a word
!
procedure edt$move_word_r		!support routine for move word (reverse)
if edt$beg_word = 0           ! Move to beginning of word, back a line if none
then
	move_horizontal(-1);
endif;
endprocedure
!
! Move forwards a word
!
procedure edt$move_word_f		!support routine for move word (forward)
if edt$end_word = 0
then
	move_horizontal(1);
endif;
endprocedure
!
! EDT Delete to beginning of word
!
procedure edt$del_beg_word		! support routine for delete word (forward)

LOCAL	 temp_length ;
edt$x_current_column := 0;		! No current column number
temp_length := edt$beg_word;      ! Go to beginning of word
if temp_length = 0
then
	if mark(none) = end_of (current_buffer)
        then
	    move_horizontal (-1);
	else
	    append_line;
	endif;
	edt$x_deleted_word := ascii(10);
else
	edt$x_deleted_word := erase_character(temp_length)
endif;
endprocedure
!
!  Find the beginning of word
!
procedure edt$beg_word			!support routine for move word

LOCAL		temp_char ,
		temp_length ;
edt$x_current_column := 0;		! No current column number
if current_offset = 0
then
	return 0;
endif;
move_horizontal(-1);                   ! Skip current character
temp_length := 1;
!
! Count any spaces
!
temp_char := current_character;
loop
    exitif current_offset = 0;
    exitif temp_char <> ' ';
    move_horizontal(-1);
    temp_length := temp_length + 1;
    temp_char := current_character;
endloop;
!
! IF we are on a word terminator count that one character. Otherwise
! scan to the next word terminator.
!
if (index(edt$x_word,temp_char) = 0)
then
    loop
	exitif current_offset = 0;
	move_horizontal(-1);
	temp_char := current_character;
	if (index(edt$x_word,temp_char) <> 0)
        then
	    move_horizontal(1);
	    exitif ;
	endif;
	temp_length := temp_length + 1;
    endloop;
endif;
return temp_length;
endprocedure
!
! Find the end of the word
!
procedure edt$end_word		!support routine for delete word

LOCAL	 temp_range ,
		temp_length ;
on_error
! catch search failure (suppress message)
return temp_length ! return 0
endon_error

	temp_range:=search(edt$x_forward_word,forward);
	temp_length:=length(temp_range);
	move_horizontal(temp_length);

return temp_length;
endprocedure

!                                                                       Page 31
!+
! EDT next Line
!-
procedure edt$next_prev_line	!kp0 (next line)
LOCAL o;	! edt equiv. of Keypad 0
edt$x_current_column := 0;		! No current column number
o := current_offset;
move_horizontal(- o);
if current_direction = forward
then
    move_vertical(1)
else
    if o = 0
    then
	move_vertical(-1)
    endif;
endif;
endprocedure


!                                                                       Page 32
!+
! Process the 7 key, PAGE.
!-
procedure edt$page		!kp7 (move to next page)
LOCAL	 dir ,
	next_page ;
on_error
if error = tpu$_strnotfound
then
    if dir = REVERSE
    then
	position(beginning_of(current_buffer))
    else
	position(end_of(current_buffer))
    endif;
endif;
return
endon_error
edt$x_current_column := 0;		! No current column number
dir := current_direction;
if dir = FORWARD
then
    move_horizontal(1)
else
    move_horizontal(-1)
endif;
next_page := search(ascii(12),dir);
position(beginning_of(next_page));
endprocedure;

!+
! EDT PASTE
!-
! After copying the text, append the current line to the last line.
! We put an extra blank line in the paste buffer during the cut.
! This way, we can get a CUT / PASTE of text without a line terminator
! to work properly
!-
procedure edt$paste		!gold kp6 (paste selected text)

LOCAL	 paste_text ;
if (beginning_of(paste_buffer) <> end_of(paste_buffer))
then
	edt$x_current_column := 0;		! No current column number
        copy_text(paste_buffer);
        append_line;
endif;
endprocedure


!
! EDT REPLACE
!
procedure edt$replace		!gold kp9 (replace)
edt$select_range;
if  ( edt$x_select_range <> 0)
then
	erase(edt$x_select_range);
	edt$paste;
	edt$x_select_range:=0;
else
	message("No Select Active");
	edt$x_repeat_count := 1;
endif;
endprocedure

!                                                                       Page 33
!+
! EDT REFRESH
!+
procedure edt$refresh
!
!	fix for bad message routine
!
    local curr_window;
    refresh;
    curr_window := current_window;
    position(message_window);
    position(end_of(current_buffer));
    update(current_window);
    position(curr_window);
endprocedure
!+
! EDT RESET
!-
procedure edt$reset		! gold kepypad dot(reset)
edt$x_current_column := 0;		! No current column number
edt$x_select_range :=0;
edt$x_search_range :=0;
edt$x_beginning_of_select := 0;
set(forward, current_buffer);
endprocedure



!+
! EDT rubout key
!-
!Delete the previous character
!
procedure edt$rubout		! rubout key (erase prev chr)
edt$x_current_column := 0;		! No current column number
edt$x_deleted_char := erase_character(-1);
if edt$x_deleted_char = edt$x_empty
then
	edt$x_deleted_char := ascii(10);
	append_line
endif;
endprocedure


!
! EDT Special insert Gold KP3 - J. Clement
!
procedure edt$SPECINS
    local char_number,line_read;
    loop;
	line_read := read_line('SPECINS:');
	edit (line_read, trim, upper);
	exitif substr(line_read,1,1) <> '?';
	edt$message('Enter:number or '+edt$x_codes);
    endloop;
    if  (index(edt$x_nonnumeric,substr(line_read,1,1)) <> 0) THEN;
  	if (substr(line_read,1,1) = '<')  then;
	    line_read := substr(line_read,2,length(line_read)-1);
	endif;
  	if (substr(line_read,length(line_read),1) = '>')  then;
	    line_read := substr(line_read,1,length(line_read)-1);
	endif;
	line_read := ' '+line_read+' ';
	char_number := index(edt$x_codes,line_read);
	if char_number = 0 then;		! illegal ?
	    edit (line_read, trim, upper);
	    message('Illegal char code "'+line_read+'"');
	else;
	    char_number := (char_number)/5;
	    copy_text(ascii(char_number));
	endif;
     else;
	if line_read <> edt$x_empty then;
	    char_number := int(line_read);
	    If (char_number < 256) and (char_number >= 0) then;
		copy_text(ascii(char_number));
	    else;
		message('Char code out of range (0-255) "'+line_read+'"');
	    endif;
	endif;
     endif;
endprocedure
!                                                                       Page 34
!+
! EDT Search
!-
procedure edt$search;			!gold pf3 (search)
	edt$x_current_column := 0;		! No current column number
	edt$x_search_position := mark(none);	! Save current position
	erase(prompt_buffer);			! Set up scratch buffer
	Set(eob_text,prompt_buffer,"Search for ?");	! With question
	map(search_window,prompt_buffer);	! And display buffer
	position(search_window);		! Now locate in buffer
	split_line;				! And leave room for text
	position(beginning_of(prompt_buffer));	! User text starts here
	set (key_map_list,"search_list");	! Set up keys
endprocedure;

procedure edt$search2(direction)	! Get the search string
LOCAL	search_term ,
	temp_mark,
	saved_error,
	temp_string,
	temp_string1,
	direction_distance;
on_error
saved_error:=error; 				! get the error #
endon_error
edt$x_current_column := 0;			! No current column number
!if get_info(prompt_buffer,"record_count") <> 0 then;	! Buffer not empty ?
  position(beginning_of(prompt_buffer));
!
!	Convert all quotes to pairs of quotes
!
  loop;
    temp_string := search('"',forward,exact);
    exitif temp_string  = 0;
    position(end_of(temp_string));
    copy_text('"');
    move_horizontal(1);
  endloop;
!
!	Now form the search string
!
  position(beginning_of(prompt_buffer));
  temp_string  := '"'+erase_line+'"';	! Construct search string
  loop;
    exitif get_info(current_buffer,"record_count") = 0;	! Buffer empty ?
    temp_string  :=  temp_string+"&LINE_END";	! End of line
    temp_string1 := erase_line;			! Get current line
    exitif (get_info(current_buffer,"record_count") = 0) and	! Exit ?
	(temp_string = edt$x_empty);
    if temp_string = edt$x_empty then;
       temp_string  :=  temp_string+'&LINE_BEGIN';
    else;
       temp_string  :=  temp_string+'&LINE_BEGIN&'+
                    '"'+temp_string1+'"';
    endif;
  endloop;
!endif;
If temp_string <> '""' then; edt$x_search_string := temp_string; endif;
edt$search_end;
!
! if the terminator was forward or reverse key,reset the direction permanently
!
if direction = 2
then
    set(reverse,current_buffer);
else
    if direction = 1
    then
	set(forward,current_buffer);
    endif;
endif;
!
!	Test search string
!
If edt$x_search_string = '""' then;		! No string ?
	edt$x_search_string  := edt$x_empty;		! Set it to empty
	edt$x_search_pattern := edt$x_empty;
	return;
endif;
update(message_window);
!
!	Create the search pattern
!
execute("edt$x_search_pattern :="+edt$x_search_string);

edt$search_next;			! Now perform search
endprocedure
!+
!	End the search mode
!-
procedure edt$search_end;
set(key_map_list,"tpu$key_map_list");		! Restore key map
unmap(search_window);				! and window
position(edt$x_search_position);		! and previous location
endprocedure


!+
! Search for the same thing again
!-
procedure edt$search_next	!pf3 (search next)
LOCAL	direction_distance,
	saved_position;

on_error
if error = tpu$_strnotfound
then
	message('String not found:'+edt$x_search_string);
	Edt$X_REPEAT_COUNT:=1;
    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
!-
edt$x_current_column := 0;		! No current column number
if current_direction = FORWARD
then
    IF (mark(none) = end_of(current_buffer))
    then
	message('String not found:'+edt$x_search_string);
	Edt$X_REPEAT_COUNT:=1;
	return;
    endif;
    direction_distance:=1;
else
    if (mark(none) = beginning_of(current_buffer))
    then
	message('String not found:'+edt$x_search_string);
	Edt$X_REPEAT_COUNT:=1;
	return;
    endif;
    direction_distance:=-1;
endif;
IF (edt$x_search_begin = 0) and (direction_distance = -1)
THEN ! move to beginning of range first)
    IF edt$x_search_range <> 0
    THEN
	saved_position:=mark(none);	! save place in case of error
	position(beginning_of(edt$x_search_range));
   ENDIF;
ENDIF;

move_horizontal(direction_distance);
edt$x_search_range := search(edt$x_search_pattern,current_direction,edt$x_search_case);
if (edt$x_search_range <> 0)
then
    if edt$x_search_video <> 0 then;
    	edt$x_search_range := 
		create_range(beginning_of(edt$x_search_range),
			   end_of(edt$x_search_range),
			   edt$x_search_video);
    endif;
    IF (edt$x_search_begin)	! SET SEARCH BEGIN is in effect
    THEN
        position(beginning_of(edt$x_search_range));
    ELSE			! SET SEARCH END is ine effect
        position(end_of(edt$x_search_range));
        move_horizontal(1);
    endif;
else
    move_horizontal(-direction_distance);
endif;
endprocedure

!                                                                       Page 35
!+
! EDT SECTION Key Emulation
!-
procedure edt$section ( direction_to_move ) !kp8 (section)
edt$x_current_column := 0;		! No current column number
if direction_to_move = forward
then
	move_vertical(edt$x_section_distance)
else
	move_vertical(- edt$x_section_distance)
endif;
move_horizontal(- current_offset);
endprocedure



!+
! EDT SELECT
!-
procedure edt$select		!keypad dot (select)
if edt$x_beginning_of_select <> 0
then
    message("Select already active")
else
    edt$x_current_column := 0;		! No current column number
    edt$x_beginning_of_select := select(edt$x_select_video);
endif;
endprocedure


!+
! EDT SUBSTITUTE
!-
procedure edt$substitute	!gold enter (substitute)
local
    r_len;
on_error
if error = tpu$_strnotfound
then
	edt$cancel_subs;
endif;
return;
endon_error
edt$x_current_column := 0;		! No current column number
if (edt$x_search_range = 0)
then
	edt$cancel_subs;
else
! Make sure we're positioned on the search range
! and haven't moved off
	if (edt$on_search_range = 1)
        then
	    erase (edt$x_search_range);
	    edt$paste;
	    edt$x_search_range:=search(edt$x_search_pattern,current_direction);
    	    IF (edt$x_search_begin)	! SET SEARCH BEGIN is in effect
    	    THEN
        	position(beginning_of(edt$x_search_range));
    	    ELSE			! SET SEARCH END is ine effect
        	position(end_of(edt$x_search_range));
        	move_horizontal(1);
    	    endif;
! If we're not still on the search range, then cancel the substitution
	else
	    edt$cancel_subs;
	endif;
endif;
endprocedure


procedure edt$cancel_subs	! support routine for substitute
	message("No Select Active");
	edt$x_repeat_count := 1;
endprocedure

!
!	Movement by arrow keys
!
procedure edt$move_horizontal(dir);
edt$x_current_column := 0;			! No current column number
move_horizontal(dir);
endprocedure
procedure edt$move_vertical(dir)
local	temp;
on_error
edt$x_repeat_count := 1;
if error = tpu$_begofbuf then
    message('Attempt to backup past the beginning of buffer '+
		get_info(current_buffer,"name"));
    return;
else;
    if error = tpu$_endofbuf then
	message('Attempt to advance past the end of buffer '+
		get_info(current_buffer,"name"));
	return;
    endif;
endif;
endon_error;
temp := get_info(current_buffer,"offset_column");
if edt$x_current_column <= 0 then;		! No current column ?
    edt$x_current_column := temp;		! Get new column number
else;
    if edt$x_horizontal_offset <> current_offset then;	! Chars added ?
	edt$x_current_column := temp;		! Get new column number
    endif;
endif;
move_vertical(dir);				! Perform the motion
temp := get_info(current_buffer,"offset_column");! New current column
if edt$x_current_column <> temp then;		! Has it shifted ?
    if edt$x_current_column > temp then;	! Move right ?
	loop;
	    exitif get_info(current_buffer,"character") = edt$x_empty;	! End of line ?
	    move_horizontal(1);
	    temp := get_info(current_buffer,"offset_column");! New current column
	    exitif edt$x_current_column <= temp; ! done ?
	endloop;	
    else;
	loop;
	    move_horizontal(-1);
	    temp := get_info(current_buffer,"offset_column");! New current column
	    exitif edt$x_current_column >= temp; ! done ?
	endloop;
	if edt$x_current_column > temp then	! must go to right ?
	    move_horizontal(1);				! Move over tab!
	endif;
    endif;
endif;
edt$X_horizontal_offset := current_offset;
endprocedure
!                                                                       Page 36
!+
! Tab the current line
!_
procedure edt$tab		!tab key
LOCAL
    tab_position;
!
! if not at the beginning of the line just insert a tab
!
edt$x_current_column := 0;		! No current column number
if (current_offset <> 0) or (edt$x_tabs_set = 0)
then
	copy_text(ascii(9));
else
!
! insert the correct number of tabs and spaces to reach the desired position
!
	tab_position := 0;
	loop
		exitif ((tab_position + 8) > edt$x_tab_goal);
		tab_position := tab_position + 8;
		copy_text(ascii(9));
	endloop;
	if (((edt$x_tab_goal / 8) * 8) <> edt$x_tab_goal)
	then
		loop
			exitif ((tab_position + 1) > edt$x_tab_goal);
			tab_position := tab_position + 1;
			copy_text(' ');
		endloop;
	endif;
endif;
endprocedure
!+
! Procedures for adjustable tabs
!-
!+
! Do a tabs adjust for the select region
!-
procedure edt$tab_adjust !ctrl t (adjust tabs)
LOCAL
    start_range ,
    end_range ,
    tab_level ,
    adjust_level ,
    original_goal ;

!+
! Get the range to adjust
!-
edt$select_range;
if (edt$x_select_range = 0)
then
    message('No select active');
    return 0;
endif;
adjust_level := edt$x_repeat_count;
edt$x_repeat_count := 1;
original_goal := edt$x_tab_goal;
start_range := beginning_of(edt$x_select_range);
end_range := end_of(edt$x_select_Range);
edt$x_select_range := 0;
position(start_range);
move_horizontal(-current_offset);
loop
    exitif mark(none) > end_range;
!+
! Go to beginning of line.
! Calculate tab depth for this line
! Strip off spaces and tabs at beginning of line.
! Set up new tab goal
! Call the tab routine.
!-
    if length (current_line) > 0
    then
    loop
	exitif (current_character <> ' ') AND (current_character <> '	');
	move_horizontal(1);
    endloop;
    tab_level := get_info(current_buffer,'offset_column') / edt$x_tab_size;
    edt$x_Tab_goal := (tab_level + adjust_level) * edt$x_tab_size;
    if (edt$x_tab_goal < 0) then edt$x_tab_goal := 0 endif;
    erase_character(-current_offset);
    edt$tab;
    endif;
    move_vertical(1);
    move_horizontal(-current_offset);
endloop;
edt$x_tab_goal := original_goal;
endprocedure

!                                                                       Page 37
!+
! EDT UNDELETE CHARACTER
!-
procedure edt$undelete_char	!gold comma (undelete character)
edt$x_current_column := 0;		! No current column number
if edt$x_deleted_char <> ascii(10)
then
    copy_text (edt$x_deleted_char)
else
    split_line
endif;
move_horizontal (-1);
endprocedure
!+
! EDT UNDELETE LINE
!-
procedure edt$undelete_line	!gold pf4 (undelete line)
    LOCAL temp_length;

edt$x_current_column := 0;		! No current column number
if (edt$x_appended_line)
then
    split_line;
    copy_text (edt$x_deleted_line);
    move_horizontal (-(current_offset + 1));
else
    temp_length := length(edt$x_deleted_line);
    if (edt$x_delete_crlf = 1) and (mark(none) <> end_of(current_buffer))
    then
        split_line;
        move_horizontal(-1);
    endif;
    copy_text(edt$x_deleted_line);
    move_horizontal( - ( temp_length ) );
endif;
endprocedure
!
! EDT Undelete WORD
procedure edt$undelete_word		!gold keypad minus(undelete word)
local two_lines;

edt$x_current_column := 0;		! No current column number
if edt$x_deleted_word <> ascii(10)
then
	if substr(edt$x_deleted_word, 1, 1) = ascii(10) then
	    split_line;
	    copy_text(substr(edt$x_deleted_word, 2, length(edt$x_deleted_word) - 1));
	else
	    copy_text(edt$x_deleted_word) ;
	endif;
	move_horizontal( - length (edt$x_deleted_word));
else
	split_line;
	move_horizontal (-1);
endif;
endprocedure

!                                                                       Page 38
procedure edt$on_end_of_line		!support routine for undelete
if (current_character = edt$x_empty)
then
	edt$on_end_of_line := 1
else
	edt$on_end_of_line := 0
endif;
endprocedure

!                                                                       Page 39
!+
! Procedure to wrap the word to the next line. Bound to space key when
! a SET WRAP is done.
!-
procedure edt$wrap_word		! space key (wrap word)
LOCAL	word_size ,
	 trash_space ;
if edt$x_wrap_position = 0
then
    return
endif;
if get_info(current_buffer,"offset_column") > edt$x_wrap_position
then
    word_size := edt$beg_word;
    split_line;
    move_horizontal(word_size);
endif;
copy_text(' ');
endprocedure

!                                                                       Page 40
!
! Bind all EDT keys
!
! Procedure to define keys to emulate EDT
!
procedure EDT$define_keys	!define all keys
LOCAL	 temp_string ;
!
! Define all the keys
!
! arrow keys
!
define_key("shift(current_window,-8)",
	   key_name(right,shift_key),"shift_right");		! shift right
define_key("shift(current_window,8)",
	   key_name(left,shift_key),"shift_left");		! shift left
define_key("edt$move_horizontal(-1)",left,"left_arrow");	! left
define_key("edt$move_horizontal(1)",right,"right_arrow");	! right
define_key("edt$move_vertical(1)",down,"down_arrow");		! down
define_key("edt$move_vertical(-1)",up,"up_arrow");		! up
!
! Editing keypad keys
!
define_key('edt$search',E1,"find");        		! find
define_key('edt$paste',E2,"paste");			! insert here
define_key('edt$cut',E3,"cut");			   	! remove
define_key("edt$select",E4,"select");			! select
define_key('edt$section(reverse)',E5,"sect");		! prev screen
define_key('edt$section(forward)',E6,"sect");		! next screen
!
! Function keys
!
define_key("edt$keypad_help",help,"keypad_diagram");	! help diagram
define_key("edt$help(edt$x_empty)",
	   key_name(help,shift_key),"vaxtpu_help");	! help on topic
!

!                                                                       Page 41
!
! keypad keys
!
!first row
!
define_key("edt$keypad_help",pf2,"keypad_diagram");	! help diagram
define_key("edt$help(edt$x_empty)",
	   key_name(pf2,shift_key),"vaxtpu_help"); 	! help on topic
define_key('edt$search_next',PF3,"fndnxt");		! find next
!define_key('edt$search',
!	   key_name(PF3,shift_key),"find");		! find
define_key('edt$search',
	   key_name(PF3,shift_key),"find");		! find
define_key('edt$delete_line',pf4,"del_l");		! delete line
define_key('edt$undelete_line',
	   key_name(pf4,shift_key),"und_l");		! undelete line
!
! second row
!
define_key('edt$page',kp7,"page");			! page
define_key("edt$line_mode(read_line('Command: '))",
	   key_name(kp7,shift_key),"ctrl_z");		! command key
define_key('edt$section(current_direction)',
	   Kp8,"sect");					! section
define_key('edt$fill',
	   key_name(kp8,shift_key),"fill");		! fill
define_key('edt$append',kp9,"append");			! append
define_key('edt$replace',
	   key_name(kp9,shift_key),"replace");		! replace
define_key('edt$delete_end_word',minus,"del_w") ;	! delete word
define_key('edt$undelete_word',
	   key_name(minus,shift_key),"und_w");		! undelete word

!
!third row
!
define_key('set(forward,current_buffer)',Kp4,"advance");	! advance
define_key('position(end_of(current_buffer))',
	   key_name(kp4,shift_key),"bottom");		! bottom
define_key('set(reverse,current_buffer)',Kp5,"backup"); ! backup
define_key('position(beginning_of(current_buffer))'
	   ,key_name(kp5,shift_key),"top");		! top
define_key("edt$cut",kp6,"cut");			! Cut
define_key("edt$paste",key_name(kp6,shift_key),"paste");! Paste
define_key('edt$delete_char',comma,"del_c");		! delete chr
define_key('edt$undelete_char',
	  key_name(comma,shift_key),"und_c");		! undelete character


!                                                                       Page 42
!
!fourth row
!
define_key('edt$move_word',kp1,"word");		! move word
define_key('edt$change_case',
	   key_name(kp1,shift_key),"chngcase");	! change case
define_key('edt$end_of_line',kp2,"eol");	! end of line
define_key('edt$delete_to_eol',
	   key_name(Kp2,shift_key),"del_eol");	! delete to end of line
define_key(
'if current_direction=forward then move_horizontal'+
'(1) else move_horizontal(-1) endif',	Kp3,"char");   ! move char
define_key("edt$specins",key_name(kp3,shift_key),"specins");	! special insert
!
!fifth row
!
define_key('edt$next_prev_line',kp0,"line");	! move to beg of  line
define_key('split_line;move_horizontal(-1)',
	   key_name(kp0,shift_key),"open_line");	! open line
define_key("edt$select",period,"select");	! Select
define_key("edt$reset",
	   key_name(period,shift_key),"reset");	! RESET
define_key('edt$substitute',
	   key_name(enter,shift_key),"subs");	! substitute

!                                                                       Page 43
!
! control keys
!
define_key('edt$x_tab_goal := current_column-1',
	    key_name('A',shift_key),"ctrl_a");	! gold ctrl a
define_key('edt$x_tab_goal := current_column-1',
	    ctrl_a_key,"ctrl_a");		! ctrl a
define_key('edt$decrease_tab',
	   key_name('D',shift_key),"ctrl_d");	! gold ctrl d
define_key('edt$decrease_tab', ctrl_d_key,"ctrl_d");	! ctrl d
define_key('edt$increase_tab',
	    key_name('E',shift_key),"ctrl_e");		! gold ctrl e
define_key('edt$increase_tab', ctrl_e_key,"ctrl_e");	! ctrl e
define_key('edt$tab',tab_key,"ctrl_i");                 ! ctrl i (tab key)
define_key('edt$del_beg_word',f13,"ctrl_j");		! ctrl j (line feed)
define_key('edt$del_beg_word',lf_key,"ctrl_j");		! ctrl j (line feed)
define_key('edt$define_key',ctrl_k_key,"ctrl_k");	! ctrl k
define_key('copy_text(ascii(12))',ctrl_l_key,"ctrl_l");	! ctrl l
define_key("edt$refresh",ctrl_r_key,"ctrl_r");		! ctrl r
define_key('edt$tab_adjust',
	   key_name('T',shift_key),"ctrl_t");		! gold ctrl t
define_key('edt$tab_adjust', ctrl_t_key,"ctrl_t");      ! ctrl t
define_key('edt$delete_beg_line',ctrl_u_key,"ctrl_u");	! ctrl u
define_key("edt$refresh",key_name('W',shift_key),"ctrl_w");	! gold ctrl w
define_key("edt$refresh",ctrl_w_key,"ctrl_w");		! ctrl w
define_key('edt$Line_mode(0)',ctrl_z_key,"ctrl_z");	! ctrl z
!
define_key("split_line",ret_key,"return");		! return
define_key('edt$backspace',f12,"backspace");		! Backspace
define_key('edt$backspace',bs_key,"backspace");		! Backspace
define_key('edt$rubout',del_key,"delete") ;		! rubout
!

!                                                                       Page 44
!
! Define the numeric keys for use with edt$gold_number
! these are necessary to emulate EDT repeat counts
!
define_key('edt$gold_number("0")',key_name('0',shift_key));
define_key('edt$gold_number("1")',key_name('1',shift_key));
define_key('edt$gold_number("2")',key_name('2',shift_key));
define_key('edt$gold_number("3")',key_name('3',shift_key));
define_key('edt$gold_number("4")',key_name('4',shift_key));
define_key('edt$gold_number("5")',key_name('5',shift_key));
define_key('edt$gold_number("6")',key_name('6',shift_key));
define_key('edt$gold_number("7")',key_name('7',shift_key));
define_key('edt$gold_number("8")',key_name('8',shift_key));
define_key('edt$gold_number("9")',key_name('9',shift_key));
define_key('edt$gold_number(edt$x_empty)',key_name('+',shift_key));
define_key('edt$gold_number("-")',key_name('-',shift_key));
!
!	Now set up keys for FIND command
!
edt$search_key_map := create_key_MAP('search_key_map');
edt$search_list := create_key_MAP_list('search_list','search_key_map');
define_key("shift(current_window,-8)",
	   key_name(right,shift_key),"shift_right","search_list");	! shift right
define_key("shift(current_window,8)",
	   key_name(left,shift_key),"shift_left","search_list");	! shift left
define_key("edt$move_horizontal(-1)",left,"left_arrow","search_list");	! left
define_key("edt$move_horizontal(1)",right,"right_arrow","search_list");	! right
define_key("edt$move_vertical(1)",down,"down_arrow","search_list");	! down
define_key("edt$move_vertical(-1)",up,"up_arrow","search_list");	! up
define_key('edt$backspace',f12,"backspace","search_list");	! Backspace
define_key('edt$backspace',bs_key,"backspace","search_list");	! Backspace
define_key('edt$delete_beg_line',ctrl_u_key,"ctrl_u","search_list");	! ctrl u
define_key('edt$del_beg_word',f13,"ctrl_j","search_list");	! ctrl j (line feed)
define_key('edt$del_beg_word',lf_key,"ctrl_j","search_list");	! ctrl j (line feed)
define_key('edt$rubout',del_key,"delete",'search_list');	! rubout
define_key("split_line",ret_key,"return",'search_list');	! return
define_key('edt$search2(1)',Kp4,"advance",'search_list');	! advance
define_key('edt$search2(2)',Kp5,"backup",'search_list');	! backup
define_key('edt$search2(0)',ENTER,"backup",'search_list');	! advance/back
define_key('edt$search2(0)',PF3,"backup",'search_list');	! advance/back
define_key('edt$search_end',key_name(period,shift_key),"",'search_list');	! Abort search
define_key('edt$search_end',ctrl_z_key,"",'search_list');		! Abort search
define_key('copy_text("	")',tab_key,"ctrl_i",'search_list');	! ctrl i (tab key)
define_key("edt$search_end;edt$line_mode(read_line('Command: '));",
	   key_name(kp7,shift_key),"ctrl_z",'search_list');	! command key
define_key("edt$specins",key_name(kp3,shift_key),"specins",'search_list');	! special insert
define_key("edt$paste",key_name(kp6,shift_key),"paste",'search_list');	! Paste
define_key("edt$keypad_help",pf2,"keypad_diagram",'search_list');	! help diagram
define_key('edt$undelete_line',
	   key_name(pf4,shift_key),"und_l",'search_list');	! undelete line
define_key('edt$undelete_word',
	   key_name(minus,shift_key),"und_w",'search_list');	! undelete word
define_key('edt$undelete_char',
	  key_name(comma,shift_key),"und_c",'search_list');	! undelete character
define_key("edt$refresh",ctrl_r_key,"ctrl_r",'search_list');	! ctrl r
!
endprocedure

!                                                                       Page 45
! This dummy procedure is here as a hook for local ones.
!
procedure tpu$local_init		! local initialization
tpu$local_init := 1;
endprocedure
!
! INITIALIZATION PROCEDURE
!
! This procedure is invoked to initialize the editing session. The windows
! and buffers are created here.
!
procedure tpu$init_procedure  ! initialization procedure
LOCAL	 temp,
        output_file_name ,
	parsed_output_file_name,
	input_file_name_only,
	message_length,
	screen_length ;

!
! Initialize our variables
edt$init_variables;
!
!  Create all the necessary default buffers and windows
!
!
! Get the show buffer next, but don't map it yet
show_buffer := create_buffer("SHOW");
set(tab_stops,show_buffer,'20 30 39 50'); ! For use with line mode emulator
set(eob_text,show_buffer,"[End of SHOW]");
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");
message_length:= screen_length/12;
if message_length < 3 then; message_length := 3; endif;
!
! Create the prompt area
!
set(prompt_area,(screen_length-message_length+1),1,reverse);
!
! Create the window for the show buffer and help buffer to be mapped to
info_window :=create_window( 1,(screen_length - 1),ON);
set(status_line,info_window,Reverse,' ');
set(width,info_window,get_info(screen,'width'));
set(pad,info_window,on);
set(video,info_window,reverse);
!
! Do the message buffer and window first. Let's get this ready for future
! information
!
temp :=message_length-1;
if temp < 2 then; temp :=2; endif;
search_window := create_window((screen_length-message_length+1),temp,OFF);
set(video,search_window,reverse);
set(text,search_window,graphic_tabs);
!set(status_line,search_window,Reverse,"Search for ?");
prompt_buffer := create_buffer("PROMPT");
set(system,prompt_buffer);
set(no_write,prompt_buffer);
prompt_window := create_window((screen_length-message_length+1),2,OFF);
set(video,prompt_window,reverse);
!set(eob_text,prompt_buffer, edt$x_empty);
message_buffer := create_buffer("MESSAGE");
set(eob_text,message_buffer,edt$x_empty);
set(permanent,message_buffer);
set(no_write,message_buffer);
set(system,message_buffer);
set(max_lines,message_buffer,20);
message_window := 
   create_window((screen_length-message_length+1),message_length,OFF);
set(video,message_window,none);
!set(scrolling,message_window,ON,message_length,0,message_length);
map(message_window,message_buffer);
!
! Now position to another buffer. This is to not have the EOB line as
! the current line when the window gets mapped and updated. We want to
! see messages
!
position(paste_buffer);
!
! Now for the main buffer. Create it from the input file
input_file := get_info(command_line,'file_name');


!+ if /nocreate is present and file does not exis,then exit

if (get_info(command_line,'create') = 0)
then
   ! /nocreate specified
   temp:=file_parse(input_file);
   if (file_search(temp)=edt$x_empty )
       AND
      (input_file <> edt$x_empty)
 	then
	! exit immediately if file not there
	 message('Input file does not exist: '+temp);
	exit
     else
	temp:=file_search(edt$x_empty) ! reset
   endif;
endif;

main_buffer := create_buffer("MAIN",input_file);


if (get_info(command_line,'read_only') = 1)
then
    set(no_write,main_buffer);
endif;
if (get_info(command_line,'output') <> 1)
then
    set(no_write,main_buffer);
else
    output_file_name := get_info(command_line,'output_file');
    if (output_file_name <> edt$x_empty)
    then

! The output file should be written to the current directory by default
! unless there is another directory specified in the output_file_name.
! We need to use sys$disk:[] as the default file specification so that
! the output file won't be written to the same directory as the input
! file if an input file directory is explicitly specified on the command line.
! We also DON'T want the node, device or directory of the input file, just
! the name.

	input_file_name_only := file_parse
				(input_file, edt$x_empty, edt$x_empty, NAME)
				 + file_parse
				(input_file, edt$x_empty, edt$x_empty, TYPE);
        parsed_output_file_name := file_parse (output_file_name, 'sys$disk:[]',
                                    input_file_name_only);
	if parsed_output_file_name <> edt$x_empty then
	    set(output_file,main_buffer,parsed_output_file_name);

! Want this buffer to be considered modified so it will be written on exit
! for use especially with MAIL/EDIT

	    position (main_buffer);
	    split_line; append_line;	! Marks it as modified
        endif;
    endif;
endif;
set(eob_text,main_buffer,"[End of MAIN]");
set(system,main_buffer);
main_window := create_window(1,(screen_length-message_length),ON);

! Make the cursor limits like EDT's
set(scrolling,main_window,ON,7,5,0);
map(main_window,main_buffer);
!
! Start journalling
!
if (get_info(command_line,'journal') = 1) and
   (get_info(command_line,'read_only') <> 1)
then
    default_journal_name := "sys$disk:[]";

    if input_file = edt$x_empty
    then
	input_file_name_only := "TPU.TJL";
    else
        input_file_name_only := file_parse
			(input_file, edt$x_empty, edt$x_empty, NAME) + ".TJL";
    endif;

    journal_file := get_info (command_line,'journal_file');
    journal_file := file_parse
		 (journal_file, default_journal_name, input_file_name_only);
    journal_open (journal_file);
endif;
!
!  Go to the current position in the main buffer
!
position(main_window);
tpu$local_init;
endprocedure

!                                                                       Page 46
!+
! This is the code to be executed when the section is being built
!-
edt$define_keys;	! bind keys
!+
! Relinguish memory taken up (unnecessarily) by the edt$define_keys procedure.
!-
compile ('procedure edt$define_keys endprocedure');
save('sys$disk:[]edtsecini.gbl');
quit