!*******************************************************************************
!
!  WGBTPU.TPU - TPU initialization file to create extended EDT
!		emulator for TPU.   Some of these functions are
!		borrowed from EVE, EVEPLUS, DECUS tapes and DSIN; 
!		others are WGB originals.
!
!  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.
!
!*******************************************************************************
procedure wgb$ident
	wgb$x_version := 'V2.300 (10/03/88)';
endprocedure
!*******************************************************************************
!
! MODIFICATIONS:
!
!   V2.300  10/04/88  Geoff Bryant	1) Add continuation lines in init files
!					2) Add user defined word delimiters
!					3) Add TPU command in init files
!
!   V2.201  10/03/88  Geoff Bryant	Allow optional erase of DCL buffer with
!					each DCL command.
!
!   V2.200   9/30/88  Geoff Bryant	1) Build procedures changed to allow
!					   VMS V4.x versus VMS V5.x conditional
!					   compiles (!VMS_V4 or !VMS_V5)
!					2) Allow for APLTPU$INIT.APLTPU init
!					   files to make it easier for users
!					   to set their own defaults.
!					3) Add GOLD_I for interactive access
!					   to init file commands.
!					4) Fix some other minor VMS 5.0 things
!					5) Add CTRL/V key to allow easy entry
!					   of control chars; the <ESC> in
!					   particluar
;
!   V2.101   9/27/88  Geoff Bryant	Fix small help bug
!
!   V2.100   9/22/88  Geoff Bryant	Add some new features:
!					1) Add GOLD_$ to execute DCL commands
!					2) Change status lines for split screen
!					3) Add date to GOLD_V
!					4) Fix bugs as described by Richard
!					   Piccard from DECUS
!					5) Add back door for Dave to allow
!					   READ_FILENAME to not display default
!					   filename when he doesn't want it.
!					6) Adjust help for new functions
!
!   V2.002   9/06/88  Geoff Bryant	Fix small VMS 5.0 bug with word defs.
!
!   V2.001   7/07/88  Geoff Bryant	Add recall to GOLD_CTRL_B
!
!   V2.000   6/28/88  Geoff Bryant	Make some updates for VMS 5.0, minor
!					bug fixes, and add some new keys:
!					1) Clean up some local/global vars
!					2) Move APLTPU keypad help into help
!					   library.
!					3) Move EDT Emulator help into APLTPU
!					   help since DEC doesn't supply it now.
!					4) Add GOLD F and associated keys for
!					   doing margin stuff.
!					5) Add GOLD TAB for variable tab stops
!					6) Allow wild cards in GOLD_CTRL_B
!
!   V1.700   2/01/88  Geoff Bryant	1) Fix small bug in BOX CUT/PASTE
!					2) Change center line to use screen
!					   width instead of buffer margins.
!					   For normal 80 column screen, no
!					   change, but for 132, you get what
!					   is visually expected.
!					3) Clean up some messages
!					4) Disable bells on broadcast too, until
!					   DEC fixes the bug.
!					5) Make two window code use screen width
!   V1.601   1/29/88  Geoff Bryant	Fix small problem with GOLD Y
!   V1.600   1/29/88  Geoff Bryant	1) Add GOLD Y to display graphics chars
!					   without translation.
!					2) Add GOLD O to toggle overstrike.
!   V1.500   1/29/88  Geoff Bryant	1) Add message to GOLD B to show state.
!					2) Disable bells on messages; TPU bug
!					   causes cursor to go out of buffer on
!					   display.  Also causes problems with
!					   callable TPU on VAXstation.
!					3) Add message to GOLD X to show state.
!   V1.404   9/11/86  Geoff Bryant	Fix a bug in GOLD Z, and add shifting
!					left and right for long messages.
!   V1.403   9/10/86  Geoff Bryant	Fix GOLD T.
!   V1.402   9/09/86  Geoff Bryant	Modify GOLD CTRL/B so that if a file
!					isn't specified, the reference buffer
!					from the last GOLD CTRL/B is used.
!   V1.401   8/13/86  Geoff Bryant	Add message buffer display.
!   V1.400   8/01/86  Geoff Bryant   	Fix things to work with VMS 4.4.
!   V1.302   6/10/86  Geoff Bryant	1) Fix infinite loop bug in GOLD J
!					2) Add back door to GOLD J for JJK
!					   to reset the defaults.
!   V1.301   5/27/86  Geoff Bryant	Make ctrl/g handle multiple postions.
!					Need to use GOLD M,G instead of CTRL/G
!					and GOLD CTRL/G.
!   V1.300   5/27/86  Geoff Bryant	1) Add set/goto mark
!					2) Add goto line
!   V1.200   5/21/86  Geoff Bryant	Change the up and down arrow keys
!					to handle tabs better.
!   V1.110   5/16/86  Geoff Bryant	Added Selected substitute
!   V1.109   4/11/86  Geoff Bryant	Improved HELP to use library
!   V1.108   4/10/86  Geoff Bryant	Added set case
!   V1.107   4/10/86  Geoff Bryant	1) Made word def init. explicit
!					2) Added buffer trimming
!   V1.106   4/09/86  Geoff Bryant	1) Modified control char translation
!					   to add single char display
!					2) Added line info command
!					3) Added tab/space conversion
!					4) Added Box CUT/PASTE
!   V1.105   4/09/86  Geoff Bryant	Added word definition toggle
!   V1.104   1/31/86  Geoff Bryant	Added ruler key
!   V1.103  12/12/85  Geoff Bryant	Added control char display
!   V1.102  12/11/85  Geoff Bryant	Made help use SYS$HELP
!   V1.101  11/15/85  Geoff Bryant	Set bell for mail and timer
!   V1.100   9/24/85  Geoff Bryant	Added window size adjusting
!   V1.001   9/24/85  Geoff Bryant	Fixed scrolling in split screens
!
!*******************************************************************************
!
! VERSION:
!
procedure wgb$version
	wgb$ident;
	message('TPU Version V'+str(get_info(system,'version'))+'.'+
			str(get_info(system,'update')));
	message('Extended EDT Keypad Emulator Version ' + wgb$x_version);
endprocedure

!*******************************************************************************
!
! PROCEDURES:
!
!	WGB$VERSION        - Display the current version of APLTPU.
!	EDT$MOTION         - Improved handling of up/down arrow keys.
!	WGB$USER_INIT_FILE - Execute user's APLTPU$INIT.APLTPU if he has one
!	WGB$USER_INIT_TERM - Execute init commands from terminal
!	WGB$DCL		   - Execute DCL commands in DCL buffer
!	WGB$TAB_SET	   - Set variable tab stops
!	WGB$TAB		   - Execute variable tab stops
!	WGB$TOGGLE_MARGINS - Toggle key definitions for margin support
!	WGB$SET_MARGIN     - Set left/right margin for margin support
!	WGB$WRAP_AND_INDENT- Does a wrap and indents to left margin
!	WGB$FILL           - Does a fill for margin support
!	WGB$DISPLAY_MESSAGE- Display the message buffer
!	WGB$SET_MARK       - Save the current position
!	WGB$GOTO_MARK      - Goto the saved position
!	WGB$GOTO_LINE      - Goto specified line
!	WGB$JJK_SUBSTITUTE - Equivalent of line mode subs/string1/string2/select
!	WGB$SET_CASE       - Set case of selected case all upper/lower
!	WGB$TRIM_BUFFER    - Trim spaces/tabs from the end of all lines in file
!	WGB$BOX_CUT        - Does a CUT in box mode.
!	WGB$BOX_PASTE      - Box mode PASTE.
!	WGB$BOX_SELECT     - Box mode SELECT.
!	WGB$TOGGLE_BOX...  - Toggle between box/normal mode for SELECT/CUT/PASTE
!	WGB$CONVERT_TABS   - Convert between tabs and spaces
!	WGB$WHAT_LINE      - Display current line/column information
!	WGB$RULER          - Display a ruler in the message area
!	WGB$WORD_TOGGLE    - Toggle word definition EDT standard/WGB standard
!	WGB$CENTER_LINE    - Center current line on screen
!	WGB$HELP           - Gives the user some help
!	WGB$START_LEARN    - Start defining a key
!	WGB$END_LEARN      - Finish defining a key
!	WGB$TWO_FILES      - Two window editing with a reference file
!	WGB$TWO_WINDOWS    - Two window editing in the current file
!	WGB$GOTO_WINDOW    - Move between top/bottom window
!	WGB$ADJUST_WINDOWS - Adjust the relative size of the two windows
!	WGB$TRANSLATE_CON. - Translates control characters
!	WGB$TOGGLE_GRAPHI. - Toggle graphic translation
!	WGB$TOGGLE_OVERST. - Toggle insert/overstrike
!	TPU$LOCAL_INIT     - Procedure to define all of our keys and to
!			   - initialize variables. (Must be last)
!
! SUBROUTINES NEEDED FOR ABOVE PROCEDURES:
!
!	WGB$USER_INIT_COMM - Execute user init commands
!	WGB$SET_COMMAND	   - Execute user init set commands
!	WGB$ENABLE_COMMAND - Execute user init enable/disable commands
!	WGB$READ_FILENAME  - Get a filename from the user (with recall)
!	WGB$READ_INTEGER   - Get an integer from the user
!	WGB$PAD_BLANK      - Inserts a padding space if needed
!	WGB$CURRENT_COLUMN - Convert current offset to current column
!	WGB$BLANK_CHARS    - Returns a string of n blanks
!	WGB$REPLACE_TABS.. - Replace tabs w/ blanks and pad line
!	WGB$INDENT_LINT_TO - Indent line to a specified column
!	WGB$TO_COLUMN      - Insert spaces from current column to specified col.
!	WGB$ADD_CTRL_TEXT  - Inserts text for a control character
!	WGB$SEARCH_CONTROL - Searches quietly for a secified character
!	WGB$DELETE_CONTROL - Replaces control Character text with the character
!	WGB$DISPLAY_CHAR.. - Dispays in message area inf abot a character
!	WGB$EDT_KEYPAD_H.. - Gives help on EDT Emulator keypad
!	EDT$HELP           - Gives line mode help
!
!*******************************************************************************

!+
!EDT UP/DOWN cursor key motion EMULATION
!-
PROCEDURE edt$motion(which_way)

LOCAL temp_col,
      last_col ,
      new_col,
      eob,
      buf;

buf := current_buffer;
EOB:=end_of(buf);

last_col := get_info(buf,'offset_column');

IF (last_col <> edt$x_prev_column)
THEN
    edt$x_target_column := last_col;
ENDIF;
move_vertical(which_way);
new_col := get_info(buf,'offset_column');
!+
! Now get us as close to the target as possible
!-

IF new_col <> edt$x_target_column
THEN
    IF new_col < edt$x_target_column
    THEN
    LOOP
    EXITIF mark(none) = EOB;
        EXITIF current_character = '';
    EXITIF new_col >= edt$x_target_column;
    move_horizontal(1);
    temp_col := get_info(buf,'offset_column');
    IF temp_col > edt$x_target_column
        THEN
        move_horizontal(-1);
        EXITIF
            ELSE
        new_col:=temp_col
    ENDIF;
     ENDLOOP;
    ELSE
    LOOP
    EXITIF current_offset = 0;
    EXITIF new_col <= edt$x_target_column;
    move_horizontal(-1);
    new_col := get_info(buf,'offset_column');
    ENDLOOP;
    ENDIF;
ENDIF;

edt$x_prev_column := new_col;
ENDPROCEDURE;

!
! WGB$USER_INITIALIZATION_FILE - Execute users APLTPU$INIT.APLTPU if he has one
!
procedure wgb$user_initialization_file
	local user_file, file_name, init_file, init_buffer, command;
	wgb$x_in_init_file := 1;
	user_file := '';
!VMS_V5	if get_info(command_line,"initialization") then
!VMS_V5		user_file := get_info(command_line,"initialization_file");
!VMS_V5	    else
!VMS_V5		return;
!VMS_V5	endif;
	file_name := file_parse(user_file,'apltpu$init','sys$disk:.apltpu');
	init_file := file_search(file_name);
	if init_file = '' then
	  file_name := file_parse(user_file,'apltpu$init','sys$login:.apltpu');
	  init_file := file_search(file_name);
	endif;
	if init_file = '' then
		if user_file <> '' then 
		    message("Can't find user initialization file");
		endif;
		return;
	endif;
	init_buffer := create_buffer('Init_buffer',init_file);
	set(no_write,init_buffer);
	set(system,init_buffer);
	position(beginning_of(init_buffer));
	command := '';
	edt$x_line := '';
	loop
	    command := erase_line;
	    edit(command,trim_trailing);
	    if command <> '' then;
		if substr(command,length(command),1) = "-" then
		    edt$x_line := edt$x_line + 
				  substr(command,1,length(command)-1);
		else
		    edt$x_line := edt$x_line + command;
		    wgb$execute_user_initialization_command;
		    command := '';
		    edt$x_line := '';
		endif;
	    endif;
	    exitif mark(none) = end_of(init_buffer);
	endloop;
	position(main_buffer);
endprocedure

!
! WGB$USER_INITIALIZATION_TERMINAL - Get user initialization commands 
!				     from terminal
!
procedure wgb$user_initialization_terminal
	local command, continued;
	wgb$x_in_init_file := 0;
	command := '';
	edt$x_line := '';
	continued := 0;
	loop
	    command := read_line('APLTPU command: ');
	    edit(command,trim_trailing);
	    exitif (command = '') and (not continued);
	    if command <> '' then
		if substr(command,length(command),1) = "-" then
		    edt$x_line := edt$x_line + 
				  substr(command,1,length(command)-1);
		    continued := 1;
		else
		    edt$x_line := edt$x_line + command;
		    wgb$execute_user_initialization_command;
		    command := '';
		    edt$x_line := '';
		    continued := 0;
		endif;
	    else
		wgb$execute_user_initialization_command;
		command := '';
		edt$x_line := '';
		continued := 0;
	    endif;
	endloop
endprocedure

!
! WGB$EXECUTE_USER_INITIALIZATION_COMMAND - Execute APLTPU init commands
!					    from init file or terminal.
!
procedure wgb$execute_user_initialization_command
	local command_name, command_index, term_char, original_line, i, s;
	on_error
	    if error = tpu$_compilefail then
		message('TPU command compilation failure');
		return;
	    endif;
	    if error = tpu$_executefail then
		message('TPU command execution failure');
		return;
	    endif;
	endon_error;
	if edt$x_line = '' then return endif;
	if substr(edt$x_line,1,1) = "!" then return endif;
	original_line := edt$x_line;
	change_case(edt$x_line,upper);
	command_name := edt$next_token('',term_char);
	command_index := index(wgb$x_commands,(' '+command_name));
	command_index := ((command_index+wgb$x_command_length)-1)/
			 wgb$x_command_length;
	case command_index from 0 to 6
	[0]:	message('Unknown command: ' + command_name);
	[1]:	wgb$set_command;
	[2]:	wgb$enable_command(1);
	[3]:	wgb$enable_command(0);
	[4]:	if not wgb$x_in_init_file then
		    edt$help('apltpu init_file initialization_files')
		endif;
!VMS_V4		refresh;
!VMS_V5		update(all);
	[5]:	s := original_line;
		change_case(s,upper);
		i := index(s,edt$x_line);
		edt$x_line := substr(original_line,i,length(original_line));
		edit(edt$x_line,compress,trim);
		message(edt$x_line);
	[6]:	if edt$x_line = '' then
		    message('TPU command not specified');
		else
		    edt$x_line := original_line;
		    s := edt$next_token('',term_char);
		    s := compile(edt$x_line);
		    if s <> 0 then execute(s) endif;
		endif;
	endcase;
endprocedure

!
! WGB$SET_COMMAND - Handles SET init commands
!
procedure wgb$set_command
	local set_name, set_index, term_char, value, ivalue;
	on_error
	endon_error;
	set_name := edt$next_token('',term_char);
	if set_name = '' then
		message('Nothing to SET');
		return;
	endif;
	set_index := index(wgb$x_sets,(' '+set_name));
	set_index := ((set_index+wgb$x_set_length)-1)/
			 wgb$x_set_length;
	case set_index from 0 to 9
	[0]:	! Unknown to us, give it to EDT Emulator line-mode SET
		edt$x_line := set_name + ' ' + edt$x_line;
		edt$set;
	[1]:	! quiet
		wgb$x_verify := 0;
		if not wgb$x_in_init_file then
			message('Command verification disabled');
		endif;
	[2]:	! Verify
		wgb$x_verify := 1;
		if not wgb$x_in_init_file then
			message('Command verification enabled');
		endif;
	[3]:	! word
		edt$x_line := "x" + edt$x_line;
		value := edt$next_token('',term_char);
		if value = 'x' then
			message('No SET WORD value specified');
			return;
		endif;
		value := substr(value,2,length(value));
		if term_char = '"' then
			wgb$x_current_word_definition := 2;
			edt$x_word := substr(value,2,length(value)-2);
			wgb$x_user_word := edt$x_word;
			edt$x_forward_word := 
			    (anchor & ( (line_end) | (span(' ')) )
			    | (any(edt$x_word)) | (scan(edt$x_word))
		            | REmain) 
		            & (line_begin | span(' ') | edt$x_empty);
			if wgb$x_verify then
			  message("WORD definition set to user supplied value");
			endif;
			return;
		endif;
		if index('EDT',value) <> 0 then
			wgb$x_current_word_definition := 2;
			wgb$word_toggle;
			return;
		endif;
		if index('NON-ALPHANUMERIC',value) <> 0 then
			wgb$x_current_word_definition := 0;
			wgb$word_toggle;
			return;
		endif;
		message('Unknown SET WORD value');
	[4]:	! right margin
		value := edt$next_token('',term_char);
		if value = '' then
			message('No SET RIGHT_MARGIN value specified');
			return;
		endif;
		ivalue := int(value);
		if (ivalue = 0) and (value <> '0') then
			message('Invalid RIGHT_MARGIN value');
			return;
		endif;
		wgb$x_right_margin := ivalue;
		if wgb$x_verify then
			message(fao("Right margin set to column !SL.",
			wgb$x_right_margin));
		endif;
	[5]:	! left margin
		value := edt$next_token('',term_char);
		if value = '' then
			message('No SET LEFT_MARGIN value specified');
			return;
		endif;
		ivalue := int(value);
		if (ivalue = 0) and (value <> '0') then
			message('Invalid LEFT_MARGIN value');
			return;
		endif;
		wgb$x_left_margin := ivalue;
		if wgb$x_verify then
			message(fao("Left margin set to column !SL.",
			wgb$x_left_margin));
		endif;
	[6]:	! Overstrike
		set(overstrike,main_buffer);
		if wgb$x_verify then
			message('MAIN buffer set to overstrike mode');
		endif;
	[7]:	! Insert
		set(insert,main_buffer);
		if wgb$x_verify then
			message('MAIN buffer set to insert mode');
		endif;
	[8]:	! Tab
		set_name := edt$next_token('',term_char);
		if set_name = '' then
			message('No SET TAB value specified');
			return;
		endif;
		set_index := index(wgb$x_tab_sets,(' '+set_name));
		set_index := ((set_index+wgb$x_tab_set_length)-1)/
				 wgb$x_tab_set_length;
		case set_index from 0 to 2
		[0]:	message('Unknown SET TAB command: '+set_name);
		[1]:	! EDT
			edt$x_line := 'TAB ' + edt$x_line;
			if edt$set then
				define_key('edt$tab',tab_key,"ctrl_i");
			endif;
		[2]:	! Every (current APLTPU TAB)
			value := edt$next_token('',term_char);
			if value = '' then
				message('No SET TAB EVERY value specified');
				return;
			endif;
			ivalue := int(value);
			if (ivalue = 0) then
				message('Invalid SET TAB EVERY value');
				return;
			endif;
			wgb$x_tab_size := ivalue;
			if wgb$x_margin_support_enabled then
   				define_key('wgb$wrap_and_indent("	")',
   					    tab_key,"ctrl_i");
   			    else
				define_key('wgb$tab',tab_key,"ctrl_i");
			endif;
			if wgb$x_verify then
				message(fao("TAB EVERY set to !SL.",
					wgb$x_tab_size));
			endif;
		endcase;
	[9]:	! DCL 
		value := edt$next_token('',term_char);
		if index('ERASE',value) <> 0 then
		    wgb$x_dcl_erase_buffer := 1;
		    if wgb$x_verify then
			message('DCL command set to ERASE buffer');
		    endif;
		else
		    if index('NOERASE',value) <> 0 then
			wgb$x_dcl_erase_buffer := 0;
			if wgb$x_verify then
			    message('DCL command set to not ERASE buffer');
		        endif;
		    else
			message('Illegal SET DCL command');
		    endif;
		endif;
	endcase;
endprocedure

!
! WGB$ENABLE_COMMAND - Handles ENABLE/DISABLE init commands
!
procedure wgb$enable_command(enable_flag)
	local enable_name, enable_index, term_char, value, mode;
	if enable_flag then
		mode := 'ENABLE';
	else
		mode := 'DISABLE';
	endif;
	enable_name := edt$next_token('',term_char);
	if enable_name = '' then
		message('Nothing to '+mode);
		return;
	endif;
	enable_index := index(wgb$x_enables,(' '+enable_name));
	enable_index := ((enable_index+wgb$x_enable_length)-1)/
			 wgb$x_enable_length;
        case enable_index from 0 to 3
        [0]:    message('Unknown ' + mode + ' command: ' + enable_name);
        [1]:    ! box select/cut/paste
                wgb$x_box_cut_paste := not enable_flag;
                wgb$toggle_box_cut_paste;
	[2]:	! margin support
		if wgb$x_margin_support_enabled <> enable_flag then
		    wgb$toggle_margins;
		else
		    if wgb$x_verify then
			if enable_flag then
			    message('Margin support enabled');
			else
			    message('Margin support disabled');
			endif;
		    endif;
		endif;
	[3]:	! display (now only does default_filename)
		value := edt$next_token('',term_char);
		if index('DEFAULT_FILENAME',value) <> 0 then
		    wgb$x_no_file_default := not enable_flag;
		    if wgb$x_verify then 
			message('Default filename display '+mode+'D');
		    endif;
		else
		    message('Illegal '+mode+' DISPLAY command');
		endif;
	endcase;
endprocedure

!
! WGB$DCL - Execute DCL commands in the DCL buffer/window
!
procedure wgb$dcl
	local dcl_cmd;
	on_error
	    if error = tpu$_createfail then
		message('Unable to create DCL subprocess');
	    endif;
!	    if error = tpu$_captive then
!		message('This command is invalid for captive account');
!	    endif;
	    return;
	endon_error;
	dcl_cmd := read_line('DCL> ');
	if dcl_cmd = '' then return endif;
	if wgb$x_dcl_process = 0 then 
	    wgb$x_dcl_buffer := create_buffer("DCL");
	    set(eob_text,wgb$x_dcl_buffer,edt$x_empty);
	    set(no_write,wgb$x_dcl_buffer);
	    set(system,wgb$x_dcl_buffer);
	    wgb$x_dcl_process := create_process(wgb$x_dcl_buffer,'$ set noon');
	endif;
	if wgb$x_number_of_windows = 1 then unmap(main_window) endif;
	wgb$x_top_window_status := 'DCL output window';
	set(status_line,wgb$x_top_window,reverse,wgb$x_top_window_status);
	set(width,wgb$x_top_window,get_info(screen,'width'));
	map(wgb$x_top_window,wgb$x_dcl_buffer);
	update(wgb$x_top_window);
	wgb$x_bottom_window_status := 'Buffer : MAIN   File: ' +
		get_info(main_buffer,'file_name');
	set(status_line,wgb$x_bottom_window,reverse,wgb$x_bottom_window_status);
	set(width,wgb$x_bottom_window,get_info(screen,'width'));
	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;
	position(wgb$x_top_window);
	position(end_of(wgb$x_dcl_buffer));
	loop
	    if wgb$x_dcl_erase_buffer then
		erase(wgb$x_dcl_buffer);
	    else
	    	split_line;
	    endif;
	    copy_text(dcl_cmd);
	    update(current_window);
	    send(dcl_cmd,wgb$x_dcl_process);
	    position(end_of(wgb$x_dcl_buffer));
	    update(current_window);
	    dcl_cmd := read_line('DCL (CTRL/Z to exit): ');
	    exitif ((dcl_cmd = '') and (last_key = ctrl_z_key));
	endloop;
	position(wgb$x_bottom_window);
endprocedure

!
! WGB$READ_FILENAME - Get a filename from the user (with recall)
!
procedure wgb$read_filename(file_name,same_as_last)
	same_as_last := 0;
	if (wgb$x_last_filename = '') or (wgb$x_no_file_default <> 0) then
	   file_name := read_line("File name: ");
	else
	   file_name := read_line(fao("File name <!AS>: ",wgb$x_last_filename));
	endif;
	if file_name = '' then file_name := wgb$x_last_filename endif;
	if (file_name = wgb$x_last_filename) and
	   (index(wgb$x_last_filename,'*') = 0) and
	   (index(wgb$x_last_filename,'%') = 0) and
	   (index(wgb$x_last_filename,'...') = 0) then
	      same_as_last := 1 endif;
	wgb$x_last_filename := file_name;
endprocedure

!
! WGB$TAB_SET - Set variable tab stops
!
procedure WGB$TAB_SET
	wgb$read_integer(wgb$x_tab_size,0,'Tab size, 0 to use EDT tab');
	if wgb$x_margin_support_enabled = 0 then
	    if wgb$x_tab_size = 0 then
		define_key('edt$tab',tab_key,"ctrl_i");
	    else
		define_key('wgb$tab',tab_key,"ctrl_i");
	    endif;
	endif;
endprocedure
!
! WGB$TAB - Execute variable tab stops
!
procedure WGB$TAB
	local num_spaces;
	if wgb$x_tab_size = 8 then
		copy_text(ascii(9));
	else
		num_spaces := current_offset -
			(current_offset/wgb$x_tab_size)*wgb$x_tab_size;
		num_spaces := wgb$x_tab_size - num_spaces;
		copy_text(substr(wgb$x_spaces,1,num_spaces));
	endif;
endprocedure

!
! WGB$TOGGLE_MARGINS - Toggle key definitions for margin support
!
procedure wgb$toggle_margins
	if wgb$x_margin_support_enabled = 0 then
		wgb$x_margin_support_enabled := 1;
		if wgb$x_verify then
			message('Margin support enabled');
		endif;
		wgb$x_save_space := lookup_key(key_name(" "),program);
		wgb$x_save_ret := lookup_key(key_name(ret_key),program);
		wgb$x_save_fill := lookup_key(key_name(kp8,shift_key),program);
		define_key('wgb$wrap_and_indent(" ")',key_name(" "));
		define_key('wgb$wrap_and_indent("	")',tab_key,"ctrl_i");
		define_key('wgb$wrap_and_indent(ret_key)',ret_key,"return");
		define_key('wgb$fill',key_name(kp8,shift_key),"fill");
	else
		wgb$x_margin_support_enabled := 0;
		if wgb$x_verify then
			message('Margin support disabled');
		endif;
		if wgb$x_save_space <> 0 then
			define_key(wgb$x_save_space,key_name(" "));
		else
			define_key('',key_name(" "));
		endif;
		if wgb$x_tab_size = 0 then
			define_key('edt$tab',tab_key,"ctrl_i");
		else
			define_key('wgb$tab',tab_key,"ctrl_i");
		endif;
		if wgb$x_save_ret <> 0 then
			define_key(wgb$x_save_ret,ret_key,"return");
		else
			define_key('',ret_key,"return");
		endif;
		if wgb$x_save_fill <> 0 then
			define_key(wgb$x_save_fill,
				   key_name(kp8,shift_key),"fill");
		else
			define_key('',key_name(kp8,shift_key));
		endif;
	endif;
endprocedure

!
! WGB$SET_MARGIN - Keys to set left and right margins
!
procedure wgb$set_margin(which_margin)
	if which_margin = 'left' then
		wgb$x_left_margin := current_column - 1;
		if wgb$x_verify then
			message(fao("Left margin set to column !SL",
			wgb$x_left_margin+1));
		endif;
	else
		wgb$x_right_margin := current_column - 1;
		if wgb$x_verify then
			message(fao("Right margin set to column !SL.",
			wgb$x_right_margin));
		endif;
	endif;
endprocedure

!
! WGB$WRAP_AND_INDENT - Do a wrap at right margin and indent to left margin
!
procedure wgb$wrap_and_indent(wrap_char)
	local	word_size,word_def;
	if wrap_char = ret_key then
	    split_line;
	    copy_text(substr(wgb$x_spaces,1,wgb$x_left_margin));
	else
	    if current_column > wgb$x_right_margin then
		word_def := edt$x_word;
		edt$x_word := ' 	';
		edt$x_forward_word := (anchor & ( (line_end) | (span(' ')) )
			       | (any(edt$x_word)) | (scan(edt$x_word))
			       | REmain) 
			       & (line_begin | span(' ') | edt$x_empty);
		word_size := edt$beg_word;
		split_line;
		copy_text(substr(wgb$x_spaces,1,wgb$x_left_margin));
		move_horizontal(word_size);
		edt$x_word := word_def;
		edt$x_forward_word := (anchor & ( (line_end) | (span(' ')) )
			       | (any(edt$x_word)) | (scan(edt$x_word))
			       | REmain) 
			       & (line_begin | span(' ') | edt$x_empty);
	    endif;
	    if (wrap_char = ascii(9)) then
		if (wgb$x_tab_size <> 0) then
		    wgb$tab;
		else
		    edt$tab;
		endif;
	    else
		copy_text(wrap_char);
	    endif;
	endif;
endprocedure

!
! WGB$FILL - FILL routine for margin support
!
procedure wgb$fill
	edt$select_range;
	if edt$x_select_range = 0 then
		message("No Select Active");
		edt$x_repeat_count := 1;
		return;
	endif;
	edt$x_whit_pat:=line_begin &(line_end|(span('	 ')
			&line_end))&line_begin;
	wgb$preserve_blanks;
	edt$x_select_range:=0;
endprocedure

procedure wgb$preserve_blanks
	local original_position,b_mark,e_mark,sub_range,
	      temp_range,all_done,temp_pattern;
	on_error
		all_done := 1;
	endon_error;
	original_position := mark(none);
	b_mark := beginning_of(edt$x_select_range);
	position(b_mark);
	move_horizontal(-current_offset);
	b_mark := mark(none);
	edt$skip_leading_spaces(b_mark);
	position(original_position);
	loop
		edt$skip_lines(b_mark);
		all_done := edt$find_whiteline(b_mark,e_mark);
		exitif  all_done;
		sub_range := create_range(b_mark,e_mark,none);
		position(e_mark);
		move_horizontal(1);
		move_vertical(1);
		b_mark:=mark(none);
		fill(sub_range," 	

",
  		     wgb$x_left_margin+1,wgb$x_right_margin);
		exitif all_done;
	endloop;
	position(original_position);
endprocedure

!
! WGB$DISPLAY_MESSAGES
!
procedure wgb$display_messages
	local char_pos, shift_amount;
	shift_amount := 0;
	if get_info(show_msg_buffer,"type") = UNSPECIFIED then
		show_msg_buffer := create_buffer("MESSAGE DISPLAY");
		set(eob_text,show_msg_buffer,edt$x_empty);
		set(no_write,show_msg_buffer);
		set(system,show_msg_buffer);
	endif;
	set(status_line,info_window,bold,'<RETURN> = Resume editing');
	set(width,info_window,get_info(screen,'width'));
	map(info_window,show_msg_buffer);
	erase(show_msg_buffer);
	copy_text(message_buffer);
	position(beginning_of(current_buffer));
	loop
		wgb$search_control('
',char_pos);
		exitif char_pos = 0;
		position(char_pos);
		erase(char_pos);
	endloop;
	position(beginning_of(current_buffer));
	loop
		wgb$search_control('
',char_pos);
		exitif char_pos = 0;
		position(char_pos);
		erase(char_pos);
		split_line;
	endloop;
	update(info_window);
	loop
		wgb$x_learn_key := read_key;
		exitif wgb$x_learn_key = ret_key;
		if wgb$x_learn_key = up then edt$motion(-1) endif;
		if wgb$x_learn_key = down then edt$motion(1) endif;
		if wgb$x_learn_key = left then
		    shift_amount := shift(current_window,40) endif;
		if wgb$x_learn_key = right then
		    shift_amount := shift(current_window,-40) endif;
		update(info_window);
	endloop;
	if shift_amount <> 0 then shift(current_window,-shift_amount) endif;
	set(status_line,info_window,edt$x_info_stats_video,
	    'Press CTRL-F to remove INFO_WINDOW and resume editing');
	unmap(info_window);
endprocedure

!
! WGB$READ_INTEGER - Get an integer from the user
!
procedure wgb$read_integer(number,default,prompt_string)
	local got_it,answer;
	on_error
	endon_error;
	got_it := 0;
	loop
		exitif got_it = 1;
		answer := read_line(fao("!AS <!SL>: ",prompt_string,default));
		edit(answer,trim);
		if answer = '' then
			number := default;
			got_it := 1;
		    else
			number := int(answer);
			if (number = 0) and (answer <> '0') then
				message(fao('Invalid integer - !AS.',answer));
			    else
				got_it := 1;
			    endif;
		    endif;
	endloop;
endprocedure

!
! WGB$SET_MARK - Mark the current position
!
procedure wgb$set_mark
	case edt$x_repeat_count from 1 to 8
        [1]: wgb$x_mark_position_1 := mark(none);
        [2]: wgb$x_mark_position_2 := mark(none);
        [3]: wgb$x_mark_position_3 := mark(none);
        [4]: wgb$x_mark_position_4 := mark(none);
        [5]: wgb$x_mark_position_5 := mark(none);
        [6]: wgb$x_mark_position_6 := mark(none);
        [7]: wgb$x_mark_position_7 := mark(none);
        [8]: wgb$x_mark_position_8 := mark(none);
	[outrange]:
		message('Invalid position number');
		edt$x_repeat_count := 1;
		return;
	endcase;
	if wgb$x_verify then
		message(fao('Position !SL saved.',edt$x_repeat_count));
	endif;
	edt$x_repeat_count := 1;
endprocedure


!
! WGB$GOTO_MARK - Goto the saved position
!
procedure wgb$goto_mark
	local mark_pos, mark_buffer;
	case edt$x_repeat_count from 1 to 8
	[1]: mark_pos := wgb$x_mark_position_1;
	[2]: mark_pos := wgb$x_mark_position_2;
	[3]: mark_pos := wgb$x_mark_position_3;
	[4]: mark_pos := wgb$x_mark_position_4;
	[5]: mark_pos := wgb$x_mark_position_5;
	[6]: mark_pos := wgb$x_mark_position_6;
	[7]: mark_pos := wgb$x_mark_position_7;
	[8]: mark_pos := wgb$x_mark_position_8;
	[outrange]:
		message('Invalid position number');
		edt$x_repeat_count := 1;
		return;
	endcase;
	if mark_pos = 0 then
		message(fao('Position !SL has not been saved',
			edt$x_repeat_count));
		edt$x_repeat_count := 1;
		return;
	    endif;
	mark_buffer := get_info(mark_pos,"buffer");
	if mark_buffer <> current_buffer then
		message('Must be in buffer '+
		        get_info(mark_buffer,"name"));
		edt$x_repeat_count := 1;
		return;
	    endif;
	position(mark_pos);
	edt$x_repeat_count := 1;
endprocedure


!
! WGB$GOTO_LINE- Goto specified line
!
procedure wgb$goto_line
	wgb$read_integer(wgb$x_line_number,wgb$x_line_number,
			 'Line number');
	position(beginning_of(current_buffer));
	move_vertical(wgb$x_line_number-1);
endprocedure

!
! WGB$JJK_SUBSTITUTE - Equivalent of line mode subs/string1/string2/select
!
procedure wgb$jjk_substitute
	local cmd, msg_text, src_range, replacement_count;
	on_error
		msg_text := fao ('!UL  replacement!%S', replacement_count) +
			         ' of '+wgb$x_string1+' with '+wgb$x_string2;
		if wgb$x_verify then
			message(msg_text);
		endif;
		edt$x_select_range := 0;
		return;
	endon_error;
	edt$select_range;
	if edt$x_select_range = 0 then
		message("Select not active");
		return;
	endif;
	loop
		if wgb$x_string1 = edt$x_empty then
			wgb$x_string1 := read_line("Search for: ");
		    else
			cmd := read_line("Search for <"+wgb$x_string1+">: ");
			if cmd <> edt$x_empty then wgb$x_string1 := cmd endif;
		endif;
		if wgb$x_string2 = edt$x_empty then
			wgb$x_string2 := read_line("Replace with: ");
		    else
			cmd := read_line("Replace with <"+wgb$x_string2+">: ");
			if cmd <> edt$x_empty then wgb$x_string2 := cmd endif;
		endif;
		exitif (wgb$x_string1 <> wgb$x_string2);
		message('Search string matches replacement string');
		wgb$x_string1 := edt$x_empty;
		wgb$x_string2 := edt$x_empty;
	endloop;
	replacement_count := 0;
	position(beginning_of(edt$x_select_range));
	loop
		src_range := search(wgb$x_string1,forward);
		exitif (beginning_of(src_range) > end_of(edt$x_select_range));
		erase(src_range);
		position(end_of(src_range));
		copy_text(wgb$x_string2);
		replacement_count := replacement_count + 1;
	endloop;
	msg_text := fao ('!UL  replacement!%S', replacement_count) +
		         ' of '+wgb$x_string1+' with '+wgb$x_string2;
	if wgb$x_verify then message(msg_text) endif;
	edt$x_select_range := 0;
endprocedure

!
! WGB$SET_CASE - Set case of selected case all upper/lower
!
procedure wgb$set_case
	local cmd;
	edt$select_range;
	if edt$x_select_range = 0 then
		message("Select not active");
		return;
	endif;
	loop
		cmd := read_line("Upper or Lower [default = L]: ");
		if cmd = edt$x_empty then cmd := 'l' endif;
		edit(cmd,compress,lower);
		cmd := substr(cmd,1,1);
		exitif ((cmd = 'l') or (cmd = 'u'));
		message("Enter U or L");
	endloop;
	if cmd = 'l' then
		change_case(edt$x_select_range,lower);
	else
		change_case(edt$x_select_range,upper);
	endif;
	edt$x_select_range := 0;
endprocedure

!
! WGB$TRIM_BUFFER - Trim spaces/tabs from the end of all lines
!
procedure wgb$trim_buffer
	local this_pos, trim_range, got_one;
	on_error
		if error = tpu$_strnotfound then trim_range := 0 endif;
	endon_error;
	this_pos := mark(none);
	loop
		got_one := 0;
		position(beginning_of(current_buffer));
		loop
			trim_range := search(span(' ')&line_end,forward);
			exitif trim_range = 0;
			position(beginning_of(trim_range));
			erase_character(length(trim_range));
			got_one := 1;
		endloop;
		position(beginning_of(current_buffer));
		loop
			trim_range := search(span('	')&line_end,forward);
			exitif trim_range = 0;
			position(beginning_of(trim_range));
			erase_character(length(trim_range));
			got_one := 1;
		endloop;
		exitif got_one = 0;
	endloop;
	position(this_pos);
endprocedure

!
! Subroutines for BOX CUT/SELECT/PASTE......
!
procedure wgb$pad_blank
	if (mark(none) = end_of(current_buffer)) then
		copy_text(' ');
		move_horizontal(-1);
	else
		if current_character = '' then
			copy_text(' ');
			move_horizontal(-1);
		endif;
	endif;
endprocedure

procedure wgb$current_column
	local i, line, col;
	line := current_line;
	if index(line,ascii(9)) = 0 then
		wgb$current_column := current_offset;
	else
		i := 1;
		col := 0;
		loop
			exitif i > current_offset;
			if substr(line,i,1) = ascii(9) then
				col := ((col + 8)/8)*8;
			else
				col := col + 1;
			endif;
			i := i + 1;
		endloop;
		wgb$current_column := col;
	endif;
endprocedure

procedure wgb$blank_chars(blank_count)
	local blank_chars, oldlen, blanks_so_far;
	if blank_count = 0 then return "" endif;
	blank_chars := " ";
	blanks_so_far := 1;
	loop
		exitif blanks_so_far >= blank_count;
		oldlen := length(blank_chars);
		blank_chars := blank_chars + blank_chars;
		blanks_so_far := blanks_so_far + oldlen;
	endloop;
	if blanks_so_far > blank_count then
		blank_chars := substr(blank_chars,1,blank_count) endif;
	return blank_chars;
endprocedure

procedure wgb$replace_tabs_with_blanks_and_pad(target_length)
	local i, col, cur_length, new_line, eight_blanks;
	if mark(none) <> end_of(current_buffer) then
		if index(current_line, ascii(9)) <> 0 then
			new_line := '';
			eight_blanks := "        ";
			i := 1;
			col := 0;
			loop
			    exitif i > length(current_line);
			    if substr(current_line,i,1) = ascii(9) then
				col := ((col + 8)/8)*8;
				new_line := new_line + substr(eight_blanks,
					                1,col-length(new_line));
			    else
				new_line := new_line + substr(current_line,i,1);
				col := col + 1;
			    endif;
			    i := i + 1;
			endloop;
			move_horizontal(-current_offset);
			copy_text(new_line);
		endif;
	endif;
	move_horizontal(-current_offset);
	if mark(none) = end_of(current_buffer) then
		cur_length := 0;
	else
		cur_length := length(current_line);
	endif;
	if cur_length < target_length then
		move_horizontal(cur_length);
		copy_text(wgb$blank_chars(target_length - cur_length));
	endif;
	move_horizontal(-current_offset);
endprocedure

!
! WGB$BOX_CUT - Does a CUT in box mode.
!
procedure wgb$box_cut
	local saved_mode, end_select, end_column, start_column,
	      temp, pad_chars, save_position, blank_chars, cut_text;
	if wgb$x_begin_select = 0 then
		message("Select not active");
		return;
	endif;
	saved_mode := get_info(current_buffer,"mode");
	set(insert,current_buffer);
	erase(paste_buffer);
    	wgb$pad_blank;
	if (mark(none) >= wgb$x_begin_select) then
		end_select := mark(none);
	else
		end_select := wgb$x_begin_select;
		wgb$x_begin_select := mark(none);
		position(end_select);
	endif;
	end_column := wgb$current_column;
	position(wgb$x_begin_select);
	wgb$x_begin_select := mark(none);
	start_column := wgb$current_column;
	if start_column > end_column then
		temp := end_column;
		end_column := start_column;
		start_column := temp;
	endif;
	pad_chars := wgb$blank_chars(end_column - start_column + 1);
	move_horizontal(-current_offset);
	set(overstrike, current_buffer);
	loop
		exitif mark(none) > end_select;
		wgb$replace_tabs_with_blanks_and_pad(end_column + 1);
		cut_text := substr(current_line, start_column + 1,
		            end_column - start_column + 1);
		move_horizontal(start_column);
		copy_text(pad_chars);
		save_position := mark(none);
		position(paste_buffer);
		copy_text(cut_text);
		move_horizontal(1);
		position(save_position);
		move_horizontal(-current_offset);
		move_vertical(1);
	endloop;
	position(wgb$x_begin_select);
	wgb$x_begin_select := 0;
	move_horizontal(-current_offset);
	move_horizontal(start_column);
	set(saved_mode,current_buffer);
endprocedure

!
! WGB$BOX_PASTE - Box mode PASTE.
!
procedure wgb$box_paste
	local save_position, start_column, paste_line, save_buffer, saved_mode;
	save_buffer := current_buffer;
	save_position := mark(none);
	start_column := wgb$current_column;
	saved_mode := get_info(current_buffer,"mode");
	set(overstrike,current_buffer);
	position(beginning_of(paste_buffer));
	if mark(none) = end_of(paste_buffer) then
		position(save_buffer);
		set(saved_mode,current_buffer);
		message("Paste buffer is empty");
		return;
	endif;
	loop
		exitif mark(none) = end_of(paste_buffer);
		paste_line := current_line;
		move_vertical(1);
		position(save_buffer);
		wgb$replace_tabs_with_blanks_and_pad(start_column+1);
		move_horizontal(start_column);
		copy_text(paste_line);
		move_vertical(1);
		position(paste_buffer);
	endloop;
	position(save_position);
	move_horizontal(-current_offset);
	move_horizontal(start_column);
	set(saved_mode,current_buffer);
endprocedure

!
! WGB$BOX_SELECT - Box mode SELECT.
!
procedure wgb$box_select
	if wgb$x_begin_select = 0 then
		wgb$pad_blank;
		wgb$x_begin_select := mark(reverse);
	else
		message("Select already active");
	endif;
endprocedure


!
! WGB$TOGGLE_BOX_CUT_PASTE - Toggle between box/normal mode for
!                            SELECT/CUT/PASTE.
!
procedure wgb$toggle_box_cut_paste
	edt$x_beginning_of_select := 0;
	edt$x_select_range := 0;
	wgb$x_begin_select := 0;
	if wgb$x_box_cut_paste = 1 then
		define_key("edt$select",period,"select");
		define_key("edt$cut",kp6,"cut");
		define_key("edt$paste",key_name(kp6,shift_key),"paste");
		define_key("edt$select",E4,"select");
		define_key("edt$cut",E3,"cut");
		define_key("edt$paste",E2,"paste");
		wgb$x_box_cut_paste := 0;
		if wgb$x_verify then
			message("SELECT/CUT/PASTE mode set to normal/EDT");
		endif;
	else
		define_key("wgb$box_select",period,"select");
		define_key("wgb$box_cut",kp6,"cut");
		define_key("wgb$box_paste",key_name(kp6,shift_key),"paste");
		define_key("wgb$box_select",E4,"select");
		define_key("wgb$box_cut",E3,"cut");
		define_key("wgb$box_paste",E2,"paste");
		wgb$x_box_cut_paste := 1;
		if wgb$x_verify then
			message("SELECT/CUT/PASTE mode set to BOX mode");
		endif;
	endif;
endprocedure

!
! WGB$CONVERT_TABS - Convert between tabs and spaces
!
procedure wgb$convert_tabs
	local cmd, cur_pos, i, t, m, n, p;
	edt$select_range;
	if edt$x_select_range = 0 then
		message("No Select Active");
		return;
	endif;
	loop
		cmd := read_line("Spaces to tabs/Tabs to spaces [default = S]: ");
		if cmd = edt$x_empty then cmd := 's' endif;
		edit(cmd,compress,lower);
		cmd := substr(cmd,1,1);
		exitif ((cmd = 't') or (cmd = 's'));
		message("Enter S or T");
	endloop;
	cur_pos := mark(none);
	position(beginning_of(edt$x_select_range));
	if cmd = 's' then
		loop
			t := search(ascii(32),forward);
			exitif (t = 0);
			exitif (beginning_of(t) > end_of(edt$x_select_range));
			position(beginning_of(t));
			m := mark(none);
			p := get_info(m,"offset_column");
			if ((8*(p/8)) = p) then
	    			i := 1;
	    			loop
	    				exitif (i = 8);
	    				move_horizontal(-1);
	    				exitif (current_character <> ' ');
	    				i := i + 1;
	    			endloop;
				if (i <> 8) then move_horizontal(1) endif;
	    			erase_character(i);
	    			copy_text(ascii(9));
			else
				move_horizontal(1);
	    		endif;
		endloop;
	else
		loop
			t := search(ascii(9),forward);
			exitif (t = 0);
			exitif (beginning_of(t) > end_of(edt$x_select_range));
			position(beginning_of(t));
			erase_character(1);
			n := current_offset;
			n := n - (8 * (n / 8));
			copy_text(substr("        ",1,8-n));
		endloop;
	endif;
	edt$x_select_range := 0;
	position(cur_pos);
endprocedure

!
! WGB$WHAT_LINE - Display information about the current line.
!
procedure wgb$what_line
	local this_position,		! current position
		start_of_buffer,	! beginning of current buffer
		this_line_position,	! position at start of this_line
		total_lines,		! total lines in buffer
		high_line,		! high line limit for binary search
		low_line,		! low line limit for binary search
		this_line,		! line number of current guess
		percent;		! percent of way through buffer

	this_position := mark (none);
	start_of_buffer := beginning_of (current_buffer);
	total_lines := get_info (current_buffer, "record_count");
	high_line := total_lines;
	if this_position = end_of (current_buffer) then
		low_line := total_lines;
	else
		low_line := 1;
	endif;
	loop
		exitif high_line - low_line <= 1;
		this_line := low_line + ((high_line - low_line) / 2);
		position (start_of_buffer);
		move_vertical (this_line - 1);
		if mark (none) > this_position then
			high_line := this_line;
		else
			low_line := this_line;
			if mark (none) = this_position then
				high_line := this_line;
			endif;
		endif;
	endloop;
	position (this_position);
	percent := (((low_line * 1000) / total_lines)+5)/10;
	this_line_position := wgb$current_column + 1;
	message (fao ("You are on line !SL out of !SL (!SL%), at column !SL.",
		      low_line, total_lines, percent, this_line_position));
endprocedure


!
! WGB$RULER - Display a ruler in the message area
!
procedure wgb$ruler
	message("         1         2         3         4         5         6         7         8");
	message("12345678901234567890123456789012345678901234567890123456789012345678901234567890");
endprocedure

!
! WGB$WORD_TOGGLE - Toggle between EDT default word definition
!		    and my word definition
!
procedure wgb$word_toggle
	if (wgb$x_current_word_definition = 0) then
		edt$x_word := " 	

'!@#$%^&*()_-+=~`{[}]:;|\<,>.?";
		edt$x_forward_word := (anchor & ( (line_end) | (span(' ')) )
			       | (any(edt$x_word)) | (scan(edt$x_word))
			       | REmain) 
			       & (line_begin | span(' ') | edt$x_empty);
		wgb$x_current_word_definition := 1;
		if wgb$x_verify then
			message("WORD definition set to non-alphanumeric");
		endif;
		return;
	endif;
	if ((wgb$x_current_word_definition = 1) and (wgb$x_user_word <> ''))
	   then
		edt$x_word := wgb$x_user_word;
		edt$x_forward_word := (anchor & ( (line_end) | (span(' ')) )
			       | (any(edt$x_word)) | (scan(edt$x_word))
			       | REmain) 
			       & (line_begin | span(' ') | edt$x_empty);
		wgb$x_current_word_definition := 2;
		if wgb$x_verify then
		  message("WORD definition set to user supplied value");
		endif;
		return;
	endif;
	edt$x_word := " 	

";
	edt$x_forward_word := (anchor & ( (line_end) | (span(' ')) )
			       | (any(edt$x_word)) | (scan(edt$x_word))
			       | REmain) 
			       & (line_begin | span(' ') | edt$x_empty);
	wgb$x_current_word_definition := 0;
	if wgb$x_verify then
		message("WORD definition set to normal/EDT");
	endif;
endprocedure

!
! WGB$CENTER_LINE - Center current line on screen
!
procedure wgb$center_line
	local this_position,
	      count,
	      l_margin,
	      r_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;
	l_margin := 1;
	r_margin := get_info(current_window,"width");
	this_column := get_info (current_buffer, "offset_column");
	count := (((r_margin-l_margin)-this_column)/2)+l_margin;
	wgb$indent_line_to (count);
	position (this_position);
endprocedure;

!
! Subroutines for CENTER TEXT
!
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;

!
! WGB$HELP - The poor user wants to know how to use all this stuff!
!
procedure wgb$help
	local timer_string;
	if get_info(help_buffer,"type") = UNSPECIFIED
	    then
		help_buffer := create_buffer("HELP");
		set(eob_text,help_buffer,edt$x_empty);
		set(no_write,help_buffer);
		set(system,help_buffer);
		help_window := create_window(1,22,off);
		set(pad,help_window,on);
		set(video,help_window,reverse);
	    endif;
	timer_string := get_info(system,'timed_message');
	if timer_string <> edt$x_empty then set(timer,off,'') endif;
	set(status_line,help_window,bold,
'  PF2 = Keypad diagram   <RETURN> = Resume editing   A = Help with APLTPU keys'
	);
	set(width,help_window,get_info(screen,'width'));
	map(help_window,help_buffer);
	help_text('apltpu','apltpu_keypad',off,help_buffer);
	position(beginning_of(help_buffer));
	erase_line;erase_line;erase_line;
	erase_character(2);move_vertical(2);
	loop
	    exitif mark(none) = end_of(help_buffer);
	    erase_character(2);
	    move_vertical(1);
	endloop;
	position(beginning_of(current_buffer));
	update(help_window);
	loop
	    wgb$x_learn_key := read_key;
	    if wgb$x_learn_key = ctrl_f_key then
		unmap(help_window);
		if timer_string <> edt$x_empty then
		    set(timer,on,timer_string) endif;
		return;
	    endif;
	    if wgb$x_learn_key = ret_key then
		unmap(help_window);
		if timer_string <> edt$x_empty then
		    set(timer,on,timer_string) endif;
		return;
	    endif;
	    if wgb$x_learn_key = PF2 then
		wgb$edt_keypad_help;
		unmap(help_window);
		if timer_string <> edt$x_empty then
		    set(timer,on,timer_string) endif;
		return;
	    endif;
	    if (wgb$x_learn_key = key_name('a')) or
	       (wgb$x_learn_key = key_name('A')) then
		set(status_line,help_window,bold,edt$x_empty);
		help_text('apltpu','apltpu',on,help_buffer);
		unmap(help_window);
		if timer_string <> edt$x_empty then
		    set(timer,on,timer_string) endif;
		return;
	    endif;
	endloop;
endprocedure

!
! WGB$EDT_KEYPAD_HELP - Give help on EDT Emulator Keys
!
procedure wgb$edt_keypad_help
	local comment_string;
	set(status_line,help_window,bold,
'Press the key that you want help on, PF2 for diagram, or RETURN to leave help'
	);
	comment_string := "keypad_diagram";
	loop
	    if comment_string = "keypad_diagram" then
		set(text,help_window,no_translate);
		help_text('apltpu','edt_keypad',off,help_buffer);
		position(beginning_of(help_buffer));
		erase_line;erase_line;erase_line;
		loop
		    exitif mark(none) = end_of(help_buffer);
		    erase_character(2);
		    move_vertical(1);
		endloop;
		erase_line;
		position(beginning_of(help_buffer));
		update(help_window);
		set(text,help_window,blank_tabs);
	    else
		if comment_string = '' then comment_string := "no" endif;
		help_text('apltpu','edt_emulator keypad '+comment_string,
		          off,help_buffer);
		position(beginning_of(help_buffer));
		erase_line;erase_line;erase_line;
		update(help_window);
	    endif;
	    wgb$x_learn_key := read_key;
	    comment_string := lookup_key(wgb$x_learn_key,comment);
	    exitif comment_string = "return";
	endloop;
endprocedure

!
! WGB$EDT_HELP - Give line mode help
!
procedure edt$help (topic_param)	! gold pf2 (help on topic)
	if get_info(help_buffer,"type") = UNSPECIFIED
	    then
		help_buffer := create_buffer("HELP");
		set(eob_text,help_buffer,edt$x_empty);
		set(no_write,help_buffer);
		set(system,help_buffer);
		help_window := create_window(1,22,off);
		set(pad,help_window,on);
		set(video,help_window,reverse);
	    endif;
	set(status_line,help_window,edt$x_info_stats_video,
	'                        Press CTRL-Z to leave prompts');
	set(width,help_window,get_info(screen,'width'));
	map(help_window,help_buffer);
	if (topic_param = edt$x_empty) then
	    help_text('apltpu',read_line('Topic: '),on,help_buffer);
	else
	    if (topic_param = 'vaxtpu') then
		help_text('tpuhelp','help',on,help_buffer);
	    else
		help_text('apltpu',topic_param,on,help_buffer);
	    endif;
	endif;
	unmap(help_window);
endprocedure

!
! WGB$START_LEARN - Begins a new key definition (learn sequence)
!
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


!
! WGB$END_LEARN - Ends a learn sequence and defines the key
!
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

!
! WGB$TWO_FILES - Two window editing with a reference file
!
procedure wgb$two_files
    local ask_file, same_as_last;
    on_error 
	if (error = tpu$_searchfail) or (error = tpu$_parsefail) then 
	    wgb$x_second_file := '';
	endif;
    endon_error;
    if wgb$x_number_of_windows = 1 then
	wgb$read_filename(ask_file,same_as_last);
	if same_as_last then ask_file := '' endif;
	wgb$x_second_file := file_search(ask_file);
	if (same_as_last = 0) and (wgb$x_second_file = '') and (ask_file <> ' ')
	    then message("No such file") endif;
	if ask_file = ' ' then
	    if wgb$x_second_buffer <> '' then delete(wgb$x_second_buffer) endif;
	    wgb$x_second_buffer := create_buffer("SCRATCH");
	    wgb$x_top_window_status := 'Scratch buffer';
	    set(eob_text,wgb$x_second_buffer,"[End of SCRATCH]");
	else
	    if wgb$x_second_buffer <> "" then
		if wgb$x_second_file <> "" then
			delete(wgb$x_second_buffer);
			wgb$x_second_buffer :=
			    create_buffer("REFERENCE",wgb$x_second_file);
		endif;
	    else
		if wgb$x_second_file = "" then return; endif;
		wgb$x_second_buffer :=
		    create_buffer("REFERENCE",wgb$x_second_file);
	    endif;
	    wgb$x_top_window_status := 'Buffer : REFERENCE   File: ' +
		get_info(wgb$x_second_buffer,'file_name');
	    set(eob_text,wgb$x_second_buffer,"[End of REFERENCE]");
	endif;
	set(no_write,wgb$x_second_buffer,on);
	unmap(main_window);
	set(status_line,wgb$x_top_window,reverse,wgb$x_top_window_status);
	set(width,wgb$x_top_window,get_info(screen,'width'));
	map(wgb$x_top_window,wgb$x_second_buffer);
	update (wgb$x_top_window);
	wgb$x_bottom_window_status := 'Buffer : MAIN   File: ' +
		get_info(main_buffer,'file_name');
	set(status_line,wgb$x_bottom_window,reverse,wgb$x_bottom_window_status);
	set(width,wgb$x_bottom_window,get_info(screen,'width'));
	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
	wgb$read_filename(ask_file,same_as_last);
	if same_as_last then ask_file := '' endif;
	wgb$x_second_file := file_search(ask_file);
	if (same_as_last = 0) and (wgb$x_second_file = '') and (ask_file <> ' ')
	    then message("No such file") endif;
	if (wgb$x_second_file = "") and (ask_file <> ' ') then return; endif;
	if wgb$x_second_buffer <> "" then delete(wgb$x_second_buffer) endif;
	if ask_file = ' ' then
	    wgb$x_second_buffer := create_buffer("SCRATCH");
	    wgb$x_top_window_status := 'Scratch buffer';
	    set(eob_text,wgb$x_second_buffer,"[End of SCRATCH]");
	else
	    wgb$x_second_buffer := create_buffer("REFERENCE",wgb$x_second_file);
	    wgb$x_top_window_status := 'Buffer : REFERENCE   File : ' +
		get_info(wgb$x_second_buffer,'file_name');
	    set(eob_text,wgb$x_second_buffer,"[End of REFERENCE]");
	endif;
	set(status_line,wgb$x_top_window,reverse,wgb$x_top_window_status);
	set(no_write,wgb$x_second_buffer,on);
	set(width,wgb$x_top_window,get_info(screen,'width'));
	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


!
! WGB$TWO_WINDOWS - Two window editing in the current file
!
procedure wgb$two_windows
    if wgb$x_number_of_windows = 1 then
	unmap(main_window);
	wgb$x_top_window_status := 'Buffer : MAIN   File : ' +
		get_info(main_buffer,'file_name');
	set(status_line,wgb$x_top_window,reverse,wgb$x_top_window_status);
	set(width,wgb$x_top_window,get_info(screen,'width'));
	map(wgb$x_top_window,main_buffer);
	update (wgb$x_top_window);
	wgb$x_bottom_window_status := 'Buffer : MAIN   File: ' +
		get_info(main_buffer,'file_name');
	set(status_line,wgb$x_bottom_window,reverse,wgb$x_bottom_window_status);
	set(width,wgb$x_bottom_window,get_info(screen,'width'));
	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);
	set(width,main_window,get_info(screen,'width'));
	map(main_window,main_buffer);
	update(main_window);
	edt$x_section_distance := wgb$x_edt_section;
	wgb$x_number_of_windows := 1;
    endif;
endprocedure

!
! WGB$GOTO_WINDOW - Move between top/bottom window
!
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


!
! WGB$ADJUST_WINDOWS - Adjust the relative size of the two windows
!
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(status_line,wgb$x_top_window,reverse,wgb$x_top_window_status);
	set(status_line,wgb$x_bottom_window,reverse,wgb$x_bottom_window_status);
	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

!
! Subroutines for control character translation
!
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$display_character
	local i,cc,ac;
	if mark(none) = end_of(current_buffer) then
		message('At end of buffer, no current character');
		return;
	endif;
	i := 0;
	loop;
		exitif i > 255;
		exitif current_character = ascii(i);
		i := i + 1;
	endloop;
	if i > 255 then i := 0 endif;
	if i < 32 then
		cc := ', ^' + ASCII(i+64);
	else
		cc := '';
	endif;
	case current_character from '' to 'ÿ'
	['']: ac := '<NUL>';
	['
']: ac := '<SOH>';
	['']: ac := '<STX>';
	['']: ac := '<ETX>';
	['']: ac := '<EOT>';
	['']: ac := '<ENQ>';
	['']: ac := '<ACK>';
	['']: ac := '<BEL>';
	['']: ac := '<BS>';
	['']: ac := '<SO>';
	['']: ac := '<SI>';
	['']: ac := '<DLE>';
	['']: ac := '<XON>';
	['']: ac := '<DC2>';
	['']: ac := '<XOFF>';
	['']: ac := '<DC4>';
	['']: ac := '<NAK>';
	['']: ac := '<SYN>';
	['']: ac := '<ETB>';
	['']: ac := '<CAN>';
	['']: ac := '<EM>';
	['']: ac := '<SUB>';
	['']: ac := '<ESC>';
	['']: ac := '<FS>';
	['']: ac := '<GS>';
	['']: ac := '<RS>';
	['']: ac := '<US>';
	['›']: ac := '<CSI>';
	[INRANGE]:  ac := current_character;
	[OUTRANGE]: ac := current_character;
	endcase;
	message(fao("Current Character is '!AS', Octal=!OB, Decimal=!-!UB, " +
                "Hex=!-!XB!AS", ac, i, cc ) );
endprocedure

!
! WGB$TRANSLATE_CONTROL - Translate/display control characters
!
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/DISPLAY_ONE [default = display_one]: ");
		if cmd = edt$x_empty then cmd := 'display_one' endif;
		edit(cmd,compress,lower);
		exitif ((cmd = 'on') or (cmd = 'off') or (cmd = 'display_one'));
		message("Enter ON, OFF, or DISPLAY_ONE");
	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;
		endif;
	if cmd = 'off' then
		wgb$delete_control;
		position(wgb$x_start_pos);
		endif;
	if cmd = 'display_one' then
		wgb$display_character;
		position(wgb$x_start_pos);
		endif;
endprocedure

!
! WGB$TOGGLE_GRAPHICS - Toggle between normal translation of graphics characters
!			and no_translate
!
procedure wgb$toggle_graphics
	if get_info(current_window,"text") = NO_TRANSLATE then
		set(text,current_window,blank_tabs);
		if wgb$x_verify then
		    message("Graphics translation set to normal/blank_tabs");
		endif;
		refresh;
	else
		set(text,current_window,no_translate);
		if wgb$x_verify then
		   message("Graphics translation set to graphics/no_translate");
		endif;
	endif;
endprocedure

!
! WGB$TOGGLE_OVERSTRIKE - Toggle between normal insert/overstrike in current
!			  buffer.
!
procedure wgb$toggle_overstrike
	if get_info(current_buffer,"mode") = OVERSTRIKE then
		set(insert,current_buffer);
		if wgb$x_verify then message("Buffer set to insert mode") endif;
	else
		set(overstrike,current_buffer);
		if wgb$x_verify then 
			message("Buffer set to overstrike mode") endif;
	endif;
endprocedure

!
! TPU$LOCAL_INIT - Procedure to define all of our keys and to
!		   initialize variables
!
procedure tpu$local_init
	local msize ;

	wgb$x_commands := ' SET     ENABLE  DISABLE HELP    MESSAGE TPU    ';
	wgb$x_command_length := 8;
	wgb$x_sets := ' QUIET        VERIFY       WORD        '+
		      ' RIGHT_MARGIN LEFT_MARGIN  OVERSTRIKE  '+
		      ' INSERT       TAB          DCL         ';
	wgb$x_set_length := 13;
	wgb$x_tab_sets := ' EDT   EVERY';
	wgb$x_tab_set_length := 6;
	edt$x_sets := ' SCREEN WRAP   CURSOR TAB    SEARCH';
	edt$x_set_length := 7;
	edt$x_searches := ' GENERAL EXACT   BEGIN   END    ';
	edt$x_searches_length := 8;
	wgb$x_enables := ' BOX     MARGIN  DISPLAY';
	wgb$x_enable_length := 8;
	wgb$x_verify := 1;

	edt$x_target_column := 1;
	edt$x_prev_column := 1;

	wgb$x_line_number := 1;
	wgb$x_mark_position_1 := 0;
	wgb$x_mark_position_2 := 0;
	wgb$x_mark_position_3 := 0;
	wgb$x_mark_position_4 := 0;
	wgb$x_mark_position_5 := 0;
	wgb$x_mark_position_6 := 0;
	wgb$x_mark_position_7 := 0;
	wgb$x_mark_position_8 := 0;
	wgb$x_string1 := edt$x_empty;
	wgb$x_string2 := edt$x_empty;
	wgb$x_box_cut_paste := 0;
	wgb$x_margin_support_enabled := 0;
	wgb$x_edt_section := edt$x_section_distance;
	wgb$x_number_of_windows := 1;
	wgb$x_second_file := "";
	wgb$x_last_filename := "";
	wgb$x_no_file_default := 0;
	wgb$x_second_buffer := "";
	wgb$x_whitespace := " 	";
	wgb$x_spaces :=
	"                                                                             ";
	wgb$x_current_word_definition := 1;
	wgb$x_user_word := '';
	edt$x_word := " 	

'!@#$%^&*()_-+=~`{[}]:;|\<,>.?";
	edt$x_forward_word := (anchor & ( (line_end) | (span(' ')) )
			       | (any(edt$x_word)) | (scan(edt$x_word))
			       | REmain) 
			       & (line_begin | span(' ') | edt$x_empty);

	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;
	wgb$x_left_margin := 0;
	wgb$x_right_margin := 75;
	wgb$x_tab_size := 0;
	wgb$x_dcl_process := 0;
	wgb$x_dcl_buffer := 0;
	wgb$x_dcl_erase_buffer:= 0;

	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,"keypad_diagram");
	define_key('edt$help("vaxtpu")',key_name(pf2,shift_key),"vaxtpu_help");
	define_key('wgb$help',help,"keypad_diagram");
	define_key('edt$help("vaxtpu")',key_name(help,shift_key),"vaxtpu_help");
	define_key('wgb$version',key_name("V",shift_key));
	define_key('wgb$ruler',key_name("R",shift_key));
	define_key('wgb$word_toggle',key_name("X",shift_key));
	define_key('wgb$what_line',key_name("Q",shift_key));
	define_key('wgb$convert_tabs',key_name("S",shift_key));
	define_key('wgb$toggle_box_cut_paste',key_name("B",shift_key));
	define_key('wgb$trim_buffer',key_name("E",shift_key));
	define_key('wgb$set_case',key_name("U",shift_key));
	define_key('wgb$jjk_substitute',key_name("J",shift_key));
	define_key('wgb$set_mark',key_name("M",shift_key));
	define_key('wgb$goto_mark',key_name("G",shift_key));
	define_key('wgb$goto_line',key_name("L",shift_key));
	define_key('edt$motion(-1)',up);
	define_key('edt$motion(1)',down);
	define_key('wgb$display_messages',key_name("Z",shift_key));
	define_key('wgb$toggle_graphics',key_name("Y",shift_key));
	define_key('wgb$toggle_overstrike',key_name("O",shift_key));
	define_key('wgb$toggle_margins',key_name("F",shift_key));
	define_key('wgb$set_margin("left")',key_name("<",shift_key));
	define_key('wgb$set_margin("right")',key_name(">",shift_key));
	define_key('wgb$tab_set',key_name(tab_key,shift_key));
	define_key('wgb$dcl',key_name("$",shift_key));
	define_key('wgb$user_initialization_terminal',key_name("I",shift_key));
	define_key('copy_text(read_char)',ctrl_v_key);

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

	wgb$user_initialization_file;

endprocedure

!VMS_V4	save('sys$disk:[]apledtsecini');
!VMS_V5	save('sys$disk:[]apltpu$section');

quit;