!
!  EDTSECINI_PLUS.TPU - TPU initialization file to create extended
!                       EDT emulator for TPU.
!
!  Author: Geoff Bryant   9/16/85
!
!	Created functions to do split screen editting, my own
!	help key, centering of text on lines, and learn keys.
!
!   V1.001   9/24/85  Geoff Bryant	Fixed scrolling in split screens
!   V1.100   9/24/85  Geoff Bryant	Added window size adjusting
!   V1.101  11/15/85  Geoff bryant	Set bell for mail and timer
!   V1.102  12/11/85  Geoff Bryant	Made help use a SYS$HELP
!   V1.103  12/12/85  Geoff Bryant	Added control char display
!   V1.104   1/24/86  J. B. Fischer     Changed reference of SYS$HELP to
!                                       TPU$LIBRARY in prep for DECUS release.
!

procedure wgb$version
	wgb$x_version := 'V1.104';
	message('TPU Version V'+str(get_info(system,'version'))+'.'+
			str(get_info(system,'update')));
	message('Extended EDT Keypad Emulator Version ' + wgb$x_version);
endprocedure

procedure wgb$center_line
	local this_position,		
	      count,			
	      left_margin,		
	      right_margin,		
	      width_of_screen,		
	      this_column;		
	this_position := mark (none);
	if this_position = end_of (current_buffer) then
	    return;
	endif;
	move_horizontal (- current_offset);
	loop
	    exitif current_character = edt$x_empty;
	    exitif index (wgb$x_whitespace, current_character) = 0;
	    count := count + 1;
	    move_horizontal (1);
	endloop;
	erase_character (- count);
	position (search (line_end, forward));
	loop
	    exitif current_offset = 0;
	    move_horizontal (-1);
	    exitif index (wgb$x_whitespace, current_character) = 0;
	    erase_character (1);
	endloop;
	left_margin := get_info (current_buffer, "left_margin");
	right_margin := get_info (current_buffer, "right_margin");
	width_of_screen := get_info (screen, "width");
	if right_margin > width_of_screen then
	    right_margin := width_of_screen;
	endif;
	this_column := get_info (current_buffer, "offset_column");
	count := (((right_margin-left_margin)-this_column)/2)+left_margin;
	wgb$indent_line_to (count);
	position (this_position);
endprocedure;

procedure wgb$indent_line_to (which_column)
	local this_position,		
	      this_buffer;		
	this_buffer := current_buffer;
	move_horizontal (- current_offset);
	loop
	    exitif get_info (this_buffer, "offset_column") >= which_column;
	    if (current_character = " ") or (current_character = ascii (9)) then
		move_horizontal (1);
	    else
		exitif 1;
	    endif;
	endloop;
	wgb$to_column (which_column);
endprocedure;

procedure wgb$to_column (which_column)
	local this_buffer,		
	      this_mode,		
	      distance;			
	this_buffer := current_buffer;
	this_mode := get_info (this_buffer, "mode");
	set (insert, this_buffer);
	loop
	    distance := which_column - get_info (this_buffer, "offset_column");
	    exitif distance <= 0;
	    if distance > length (wgb$x_spaces) then
		copy_text (wgb$x_spaces);
	    else
		copy_text (substr (wgb$x_spaces, 1, distance));
	    endif;
	endloop;
	set (this_mode, this_buffer);
endprocedure;

procedure wgb$help
	set(status_line,info_window,edt$x_info_stats_video,edt$x_empty);
	set(width,info_window,get_info(screen,'width'));
	map(info_window,help_buffer);
	erase(help_buffer);
	read_file('TPU$LIBRARY:EDTSECINI_PLUS.HLP');
	update(info_window);
	loop
	    wgb$x_learn_key := read_key;
	    if wgb$x_learn_key = ctrl_f_key then
		unmap(info_window);
		return;
	    endif;
	    if wgb$x_learn_key = ret_key then
		unmap(info_window);
		return;
	    endif;
	    if wgb$x_learn_key = PF2 then
		edt$keypad_help;
		unmap(info_window);
		return;
	    endif;
	endloop;
endprocedure

procedure wgb$start_learn
	message ('Hit key to learn');
	wgb$x_learn_key := read_key;
	message ('Enter the learn sequence (CTRL/R to end)');
	learn_begin(exact);
endprocedure

procedure wgb$end_learn
	on_error
	    if error = tpu$_notlearning then
		message ("Nothing to remember");
	        return;
	    else
		if error = tpu$_recurlearn then
		    message("Recursive learn procedure");
		    return;
		endif;
	    endif;
	endon_error;
	wgb$x_learn_sequence := learn_end;
	message ('End learn sequence');
	define_key(wgb$x_learn_sequence,wgb$x_learn_key);
endprocedure

procedure wgb$two_files
    if wgb$x_number_of_windows = 1 then
	if wgb$x_second_buffer <> "" then
		delete(wgb$x_second_buffer);
	    endif;
	wgb$x_second_file := read_line("File name: ");
	wgb$x_second_buffer := create_buffer("REFERENCE",wgb$x_second_file);
	set(eob_text,wgb$x_second_buffer,"[End of REFERENCE]");
	set(no_write,wgb$x_second_buffer,on);
	unmap(main_window);
	map(wgb$x_top_window,wgb$x_second_buffer);
	update (wgb$x_top_window);
	map(wgb$x_bottom_window,main_buffer);
	update (wgb$x_bottom_window);
	position (wgb$x_top_window);
	edt$x_section_distance := wgb$x_top_section;
	wgb$x_number_of_windows := 2;
    else
	if wgb$x_second_buffer <> "" then
		delete(wgb$x_second_buffer);
	    endif;
	wgb$x_second_file := read_line("File name: ");
	wgb$x_second_buffer := create_buffer("REFERENCE",wgb$x_second_file);
	set(eob_text,wgb$x_second_buffer,"[End of REFERENCE]");
	set(no_write,wgb$x_second_buffer,on);
	map(wgb$x_top_window,wgb$x_second_buffer);
	update (wgb$x_top_window);
	position (wgb$x_top_window);
	edt$x_section_distance := wgb$x_top_section;
	wgb$x_number_of_windows := 2;
    endif;
endprocedure

procedure wgb$two_windows
    if wgb$x_number_of_windows = 1 then
	unmap(main_window);
	map(wgb$x_top_window,main_buffer);
	update (wgb$x_top_window);
	map(wgb$x_bottom_window,main_buffer);
	update (wgb$x_bottom_window);
	edt$x_section_distance := wgb$x_bottom_section;
	wgb$x_number_of_windows := 2;
    else
	unmap(wgb$x_top_window);
	unmap(wgb$x_bottom_window);
	map(main_window,main_buffer);
	update(main_window);
	edt$x_section_distance := wgb$x_edt_section;
	wgb$x_number_of_windows := 1;
    endif;
endprocedure

procedure wgb$goto_window (which_window)
    if wgb$x_number_of_windows = 2 then
	position(which_window);
	if which_window = wgb$x_top_window then
		edt$x_section_distance := wgb$x_top_section;
	    else
		edt$x_section_distance := wgb$x_bottom_section;
	    endif;
    endif;
endprocedure

procedure wgb$adjust_windows
    local asize, top_window_buffer, in_top;
    if wgb$x_number_of_windows = 2 then
	top_window_buffer := get_info(wgb$x_top_window,"buffer");
	if current_window = wgb$x_top_window 
            then in_top:=1; else in_top:=0; endif;
	loop
	    asize := read_line("Enter the number of lines to adjust by: ");
	    asize := int(asize);
	    exitif ((wgb$x_top_size - asize) > 3) and
	           ((wgb$x_bottom_size + asize) > 3);
	    message("Illegal adjustment");
	endloop;
	wgb$x_top_size := wgb$x_top_size - asize;
	wgb$x_bottom_size := wgb$x_bottom_size + asize;
	delete(wgb$x_top_window);
	delete(wgb$x_bottom_window);
	wgb$x_top_window := create_window (1,wgb$x_top_size,on);
	wgb$x_bottom_window := create_window (wgb$x_top_size+1,
					      wgb$x_bottom_size,on);
	set(scrolling,wgb$x_top_window,on,1,1,0);
	set(scrolling,wgb$x_bottom_window,on,1,1,0);
	wgb$x_top_section := (wgb$x_top_size*3)/4;
	wgb$x_bottom_section := (wgb$x_bottom_size*3)/4;
	if in_top = wgb$x_top_window then
		edt$x_section_distance := wgb$x_top_section;
	    else
		edt$x_section_distance := wgb$x_bottom_section;
	    endif;
	map(wgb$x_top_window,top_window_buffer);
	map(wgb$x_bottom_window,main_buffer);
	if in_top then
		position(wgb$x_top_window);
	    else
		position(wgb$x_bottom_window);
	    endif;
	refresh;
    endif;
endprocedure

procedure wgb$add_ctrl_text(char)
	case char from ' ' to 'ÿ'
	[' ']: copy_text('<NUL>');
	['']: copy_text('<SOH>');
	['']: copy_text('<STX>');
	['']: copy_text('<ETX>');
	['']: copy_text('<EOT>');
	['']: copy_text('<ENQ>');
	['']: copy_text('<ACK>');
	['']: copy_text('<BEL>');
	['']: copy_text('<BS>');
	['']: copy_text('<SO>');
	['']: copy_text('<SI>');
	['']: copy_text('<DLE>');
	['']: copy_text('<XON>');
	['']: copy_text('<DC2>');
	['']: copy_text('<XOFF>');
	['']: copy_text('<DC4>');
	['']: copy_text('<NAK>');
	['']: copy_text('<SYN>');
	['']: copy_text('<ETB>');
	['']: copy_text('<CAN>');
	['']: copy_text('<EM>');
	['']: copy_text('<SUB>');
	['']: copy_text('<ESC>');
	['']: copy_text('<FS>');
	['']: copy_text('<GS>');
	['']: copy_text('<RS>');
	['']: copy_text('<US>');
	['›']: copy_text('<CSI>');
	endcase;
endprocedure

procedure wgb$search_control(char,found)
	on_error
		found := 0;
		return;
	endon_error;
	found := search(char,forward,exact);
endprocedure

procedure wgb$delete_control
	local found,char_pos,old_message_flags;
	old_message_flags := get_info(system,"message_flags");
	set(message_flags,0);
	loop
		found := 0;
		position(beginning_of(current_buffer));
		wgb$search_control('<NUL>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text(' ');
			found := 1;
		endif;
		wgb$search_control('<SOH>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<STX>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<ETX>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<EOT>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<ENQ>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<ACK>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<BEL>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<BS>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<SO>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<SI>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<DLE>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<XON>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<DC2>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<XOFF>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<DC4>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<NAK>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<SYN>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<ETB>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<CAN>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<EM>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<SUB>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<ESC>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<FS>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<GS>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<RS>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<US>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('');
			found := 1;
		endif;
		wgb$search_control('<CSI>',char_pos);
		if char_pos <> 0 then
			position(char_pos);
			erase(char_pos);
			copy_text('›');
			found := 1;
		endif;
		exitif (found = 0)
	endloop;
	set(message_flags,old_message_flags);
endprocedure

procedure wgb$translate_control
	local char,char_pos,cmd,ctrl_chars,disp_chars,displ_chars;
	on_error
		position(wgb$x_start_pos);
		return;
	endon_error;
	wgb$x_start_pos := mark (none);
	ctrl_chars := any(' ›');
	loop
		cmd := read_line("ON/OFF [default = off]: ");
		if cmd = edt$x_empty then cmd := 'off' endif;
		edit(cmd,compress,lower);
		exitif ((cmd = 'on') or (cmd = 'off'));
		message("Enter ON or OFF");
	endloop;
	if cmd = 'on' then
		position(beginning_of(current_buffer));
		loop
			char_pos := search(ctrl_chars,forward,exact);
			position(char_pos);
			char := current_character;
			wgb$add_ctrl_text(char);
			erase(char_pos);
		endloop;
	else
		wgb$delete_control;
		position(wgb$x_start_pos);
	endif;
endprocedure

procedure tpu$local_init
	local msize ;

	wgb$x_edt_section := edt$x_section_distance;
	wgb$x_number_of_windows := 1;
	wgb$x_second_file := "";
	wgb$x_second_buffer := "";
	wgb$x_whitespace := " 	";	
	wgb$x_spaces :=			
	"                                                                             ";

	msize := get_info(main_window,"original_length");
	wgb$x_top_size := msize/2;
	if ((msize/2)*2) = msize then 
		wgb$x_bottom_size := msize/2;
	    else
		wgb$x_bottom_size := msize/2+1;
	    endif;
	wgb$x_top_window := create_window (1,wgb$x_top_size,on);
	wgb$x_bottom_window := create_window (wgb$x_top_size+1,
					      wgb$x_bottom_size,on);
	set(scrolling,wgb$x_top_window,on,1,1,0);
	set(scrolling,wgb$x_bottom_window,on,1,1,0);
	wgb$x_top_section := (wgb$x_top_size*3)/4;
	wgb$x_bottom_section := (wgb$x_bottom_size*3)/4;

	define_key('wgb$start_learn',ctrl_k_key);
	define_key('wgb$end_learn',ctrl_r_key);
	define_key('wgb$goto_window(wgb$x_bottom_window)',
                   key_name(down,shift_key));
	define_key('wgb$goto_window(wgb$x_top_window)',
                   key_name(up,shift_key));
	define_key('wgb$adjust_windows',key_name("W",shift_key));
	define_key('wgb$two_files',key_name(ctrl_b_key,shift_key));
	define_key('wgb$two_windows',ctrl_b_key);
	define_key('wgb$center_line',key_name("C",shift_key));
	define_key('wgb$translate_control',key_name("T",shift_key));
	define_key('edt$command',do);
	define_key('wgb$help',pf2);
	define_key('wgb$version',key_name("V",shift_key));

	set(bell,all,on);
	set(timer,on," Working ");

endprocedure

save('edtsecini_plus.gbl');
quit;