! File:		ATG_EVE.TPU	Define the ATG EVE keypad startup file environment
! Creation:	24 March 1986
! Author:	Nick de Smith
!		Applied Telematics Services, 7 Vale Avenue, Tunbridge Wells, Kent TN1 1DJ, England.
!		+44 892 511000, PSI%234213300154::NICK
!
! Copyright (c) 1986,1987,1988,1989 by Applied Telematics Group Limited and Nick de Smith.
! This software is supplied for information only. No guarantee is supplied for this software, and no liability
! will be accepted for any action resulting from the use of this software or the information contained herein.
! Under no circumstances may this software be used for commercial gain, including its sale, lease or loan.
! This software may be copied only with the inclusion of this copyright notice.
! The author is prepared to enter into correspondance with interested parties, but will not necessarily
! maintain this software. Having said all that, enjoy it!
!
! Edit	Edit date	By	Why
! 2.04	19-Sep-89	NMdS	Fix minor bug/problem where editing an illegal file name (eg. "&#$$&%!$") would cause
!				an annoying message ("Parameter 1's data type...).
! 2.03	02-May-89	NMdS	Check it works with DECwindows (it does! and without modification too!)
!				Well, it works under 5.1, but DECwindows EVE has a problem with starting up in 132 columns.
!				Try starting up in 80 columns under DECwindows.
! 2.02	20-Dec-88	NMdS	Added in wildcard support for GOLD I. Added in general mark processing for GOLD./F18
!				as per EVE (in fact, use the EVE routines to do it).
!				When a buffer other than MAIN is made writeable, mark it as modified so that the user
!				will always be asked about writing it.
! 2.01	23-Nov-88	NMdS	VMS V5.0 (largely re-written from my previous versions)
!
! Description
! ===========
!
! ATG_EVE is an EVE "product" that implements a version of the "EDT standard" initialiser. When built into
! a product and, invoked as described below, the user is presented with an editor that is VERY similar to EDT.
! All the key definitions that the user would expect are there, including those from the "standard initialiser".
! However, all of EVE is also there, so if you want any EVE functions, they are also available.
! We find that this is a very good way of weaning users from EDT onto EVE and real TPU.
!
! The extra functions (on top of the EDT keypad) are:
!
!	GOLD .		Insert special marker.
!			Inserts a marker of the form "~~/\~~" into the text that GOLD / can locate. You can define the
!			symbol "atg$x_text_marker" in your initialisation file to some other string, if you wish.
!	GOLD /		Locate and remove special marker.
!	GOLD $		Spawn a sub-process.
!			Suspends the editing session and transfers control of the terminal to the sub-process.
!			When you log out, the editing session resumes.
!	GOLD ^		Execute a single DCL command and include the output in the current buffer.
!			Very useful for including DIRECTORY output etc.
!	GOLD B		Switch to specified buffer. If the buffer does not exist, it is created. If you type <CR>
!			to the prompt, you will be given a menu of available buffers to switch to (see GOLD S below).
!	GOLD I		Include a file into the named buffer. The default for the buffer name is the FILENAME.TYPE
!			of the included file. If a "." is specified at the end of a buffer name, then the file is included
!			at the current editing position in that buffer, otherwise the file is included at the start of
!			the buffer. You may specify wildcards in the include specification.
!	GOLD L		Switch to last used buffer. Very useful for "toggling" between buffers.
!	GOLD M		Switch to the "MAIN" buffer.
!	GOLD O		Output the specified buffer to a file. The default is to use the current buffer. The defaults
!			for the filename are SYS$DISK:[]BUFFERNAME
!	GOLD P		Protect the specified buffer. Using GOLD P toggles the "un-modifiable" bit on the specified buffer.
!	GOLD Q		Quit from the editor. If you have modified any writeable buffers, then you will be asked if you
!			really mean to quit.
!	GOLD R		Make buffer read-only. The default is to use the current buffer. This prevents the specified
!			buffer from being written to a file when the editor exits. Use with caution.
!	GOLD S		Show buffer list. The list of available buffers is displayed as a menu. You can use the UP-ARROW
!			(or PREV_SCREEN) and DOWN-ARROW (or NEXT_SCREEN) keys to select a buffer, and SELECT, ENTER or RETURN
!			to switch to that buffer. The default menu position is to select the current buffer. The selected buffer
!			name is highlighted as you move the menu position.
!			The first three characters in the menu line are:
!				Character	Meaning
!				   R		Buffer is read-only (will not be written when the editor exits).
!				   W		Buffer will be written when the editor exits.
!				   M		Buffer contents has been modified since it was created.
!				   =		Buffer is the "current" buffer.
!			If the filename field contains a name in brackets, eg. (USER_ROOT:[NICK]LOGIN.COM), then the name
!			is that of the last file included into the buffer (eg. with GOLD I), otherwise the filename field contains
!			the name of the file, if any, that will be generated when the editor exits.
!	GOLD V		Show the version of this file.
!	GOLD W		Make buffer writeable. The default is to use the current buffer. You will be asked for the name of
!			the file that you wish the specified buffer to be written to when the editor exits. The default filename
!			is SYS$DISK:[]BUFFERNAME. eg. if your buffer is called FRED.FLINT, then the file generated will be
!			SYS$DISK:[]FRED.FLINT
!
!	GOLD CTRL/G	Replace the SELECT region with the contents of the specified buffer.
!	CTRL/G		Paste the specified buffer into the current buffer (include it at the current position).
!	GOLD CTRL/P	Cut the SELECT region to the specified buffer.
!	CTRL/P		Copy the SELECT region to the specified buffer.
!	GOLD CTRL/W	Toggle screen width between 80 and 132 columns. The editor comes up in 132 column mode by default.
!			Include the line "tpu atg$set_screen_width(80)" in your EVE initialisation file (normally called
!			SYS$LOGIN:EVE$INIT.EVE). Alternatively include "atg$set_screen_width(80)" in your TPU command file
!			(normally called TPU$COMMAND.TPU). See below for a discussion on how to find out more about EVE and
!			TPU initialisation files. If you are on VAXstation using UIS$EMULATORS for your TPU window, you can
!			specify any width to "atg$set_screen_width()" (within reason!).
!	F7		As CTRL/G	(insert buffer)
!	GOLD F7		As GOLD CTRL/G	(replace select with buffer)
!	F8		As CTRL/P	(copy select to buffer)
!	GOLD F8		As GOLD CTRL/P	(cut select to buffer)
!	F17		Make the next window the current window (if there is more than 1 window on the screen). This is the
!			same as the EVE NEXT WINDOW command.
!	GOLD F17	Toggle between 1 or 2 windows on the screen. This does an EVE SPLIT_WINDOW 2 command if there is only
!			one window on the screen, else it does an EVE ONE WINDOW command.
!	F18		Insert EVE style named marker. This differs from GOLD . in that you are asked for the name of
!			the mark. The mark can lie in any buffer, and any number of marks can co-exist. If you enter a
!			name that is already in use, the previous mark for that name is deleted. Note that marks entered
!			via F18 are lost when the editor is left. Similar to an EVE MARK name command.
!	GOLD F18	Locate and move to an EVE style named marker. This command also locates marks entered by key F18.
!			The buffer that the mark is located in is mapped to the current window. Similar to an EVE GO TO name
!			command.
!	F19		Insert the current date in the form "DD-Mmm-YY". If the day is in the range 1 to 9, a leading "0" is
!			included.
!	GOLD F19	Insert the current time in the form "HH:MM".
!	F20		Locate position in buffer. Displays a line of the form "Line n of m (p%)"
!
! Note that using GOLD HELP or GOLD PF2 will give an on-line list of keys including those specified above, and that HELP
! (or PF2) will generate a keypad diagram including the above additions.
!
! Building and Invoking ATG_EVE
! =============================
!
! This file contains an EVE "product" that is built using EVE$BUILD under VMS V5 as follows (see ATG_EVE.COM):
!
!	$ Edit /Tpu /NoDisplay /Section=EVE$SECTION /Command=SYS$EXAMPLES:EVE$BUILD /NoInit ATG_EVE
!
! The resulting section is invoked as follows:
!
!	$ Edit /Tpu /Section=dev:[dir]ATG_EVE [/Command=init-file.TPU] [/INITIALIZATION=init-file.eve] file-name.type
!
! or, for old die-hards...
!
!	$ Edt == "Edit /Tpu /Section=ATG_EVE"		(no device/directory needed if section is in SYS$LIBRARY)
!	$ Edt filename.type
!
! We place the EDT definition in the SYS$SYLOGIN command file, and always move the section to SYS$COMMON:[SYSLIB] and
! INSTALL it open and shared (see INSTALL.COM).
!
! For more information on TPU and EVE initialisation command files, refer to the VMS V5 manual
! "Volume 5B (General User) Processing Text, VAXTPU Program Development", section 5.4 (VAXTPU Startup Files) and section
! 5.4.4 (EVE Initialisation Files).
!
! Note that under VMS V5 the section can be INSTALLed (see INSTALL.COM), eg.
!
!	$ Install Create Sys$Library:ATG_EVE.TPU$SECTION /Open /Header_Res /Shared
!
! INSTALLing the section shared is highly recommended. Major performance benifits can be gained on systems which have more
! than one user using this editing section.
!

!
! Local command procedure initialisation
!
procedure ATG_MODULE_IDENT
	return "V02.04";						! Version of this file
endprocedure

procedure ATG_MODULE_PRE_INIT
!
eve$x_select_remove_flag := FALSE;					! Make <SELECT><REMOVE> just clear the paste buffer
eve$add_word_separators("`~!@#$%^&*()_+-={}[]:|;'\,.?/<>"+'"');		! Define our word separator list
									! (EVE base set is: space, HT, FF, CR, VT, LF)
!
endprocedure

procedure ATG_MODULE_INIT
local	temp;
!
eve$bound_cursor;							! Set cursor movement to be sensible
!
set(timer,on,"Working...");						! Flash a message while editor is busy
set(bell,broadcast,on);							! Enable bell for broadcast messages
atg$x_text_marker := "~~/\~~";						! Special marker used for GOLD "." and GOLD "/"
atg$x_last_buffer_ptr := current_buffer;				! Last buffer that we used
if atg$x_screen_width = TPU$K_UNSPECIFIED then				! If no screen width set up yet...
	atg$set_screen_width(132);					! ...start up in 132 column mode
endif;
atg$x_input_file := create_array;					! Array of input files (GOLD I)
!
! Define the buffer for outputting screen full information
!
atg$x_show_buffer := create_buffer("$ATG_SHOW$");
set(eob_text,atg$x_show_buffer,atg$x_empty);
set(no_write,atg$x_show_buffer);
set(system,atg$x_show_buffer);
!
! Define the window for outputting screen full information
!
atg$x_show_window := create_window(1,get_info(screen,"visible_length")-2,on);
set(width,atg$x_show_window,get_info(screen,"width"));
set(status_line,atg$x_show_window,reverse," Move to required buffer, then press SELECT or ENTER");
set(scrolling,atg$x_show_window,on,4,4,0);				! Make scrolling sensible in show window
!
atg$x_top_margin := 3;							! Offset from top of window to cursor
atg$x_bottom_margin := 3;						! Offset from bottom of window to cursor
atg$x_main_buffer_ptr := get_info(eve$main_window,"buffer");		! => to EVE's main buffer
atg$x_main_buffer_name := get_info(atg$x_main_buffer_ptr,"name");	! Name of EVE's main buffer
set(eob_text,atg$x_main_buffer_ptr,"[End of " + atg$x_main_buffer_name + "]"); ! Set nice name for main buffer end
set(scrolling,eve$main_window,on,atg$x_top_margin,atg$x_bottom_margin,0); ! Keep editing point near middle of screen
if get_info(command_line,"output_file") = atg$x_empty then		! If there was no explicit output file...
	temp := get_info(atg$x_main_buffer_ptr,"output_file");		! ...try to determine the output file
	if get_info(temp,"type") = STRING then				! If there was a name...
		set(output_file,atg$x_main_buffer_ptr,			! ...set the output file name to lose the ";version"
			file_parse(temp,atg$x_empty,atg$x_empty,NODE,DEVICE,DIRECTORY,NAME,TYPE));
	endif;
	eve$update_status_lines;					! Update all EVE status lines
endif;
!
endprocedure
!
! EVE status line routine for module ATG
!
! Adds a field on the status line for each editing window that says what output file, if any, is associated
! with the buffer. If there is no output file (the buffer is read only) the name of the last file read into
! the buffer is displayed.
!
procedure ATG_STATUS_FIELD( the_length, the_format )
local	file_name,
	prefix;
on_error
	[OTHERWISE]:
endon_error;
case atg$get_buffer_filename(current_buffer,file_name)
	[-1]:	prefix := "Out: ";					! There is an output file name
	[0]:	return atg$x_empty;					! There is no filename to use
	[1]:	prefix := "In: ";					! There is an input filename
	[OTHERWISE]: prefix := "? ";					! God knows what there is!
endcase;
return fao(the_format, prefix + file_name);				! Format the message and return it to EVE
endprocedure

!
! GOLD B	switch to the named buffer
!
procedure atg$switch_buffer
local	buffer_name,
	buffer_ptr;
buffer_name := read_line(" Buffer: ");					! Get name of buffer to use
if buffer_name = atg$x_empty then					! If no buffer name was given...
	return atg$show_buffers;					! ...select from list
endif;
buffer_ptr := atg$find_buffer(buffer_name);				! Locate specified buffer
if buffer_ptr = 0 then
	return;
endif;
atg$map_buffer(buffer_ptr);						! Switch to located buffer
endprocedure

!
! CTRL/G	paste named buffer
!
procedure atg$paste_buffer
local	buffer_name,
	buffer_ptr;
buffer_name := read_line(" Paste from buffer: ");			! Get name of buffer to paste in
if buffer_name = atg$x_empty then
	atg$message("No buffer name specified");
	return;
endif;
buffer_ptr := atg$find_buffer(buffer_name);				! Locate specified buffer
if buffer_ptr = 0 then
	return;
endif;
copy_text(buffer_ptr);							! Insert named buffer at current position
endprocedure
!
! GOLD CTRL/G	erase select region then paste named buffer
!
procedure atg$erase_and_paste_buffer
local	buffer_name,
	buffer_ptr,
	the_range;
on_error
	[TPU$_NOSELECT,TPU$_SELRANGEZERO]:
		atg$message("No current select range");
		return eve$learn_abort;
	[OTHERWISE]:
		return eve$learn_abort;
endon_error;
the_range := select_range;						! Locate current select range
buffer_name := read_line(" Replace with buffer: ");
if buffer_name = atg$x_empty then
	atg$message("No buffer name specified");
	return;
endif;
buffer_ptr := atg$find_buffer(buffer_name);				! Locate the specified buffer
if buffer_ptr = 0 then
	return;
endif;
erase(the_range);							! Erase the selected region
eve$x_select_position := 0;						! Reset EVE select region
copy_text(buffer_ptr);							! Copy the new buffer into place
endprocedure

!
! GOLD I	include a file into a buffer
!
procedure atg$include
local	file_name,
	file_found,
	temp_file_name,
	response,
	buffer_name,
	buffer_name_length,
	buffer_ptr,
	prompt,
	include_at_top;
on_error
	[TPU$_CONTROLC]:
		atg$message("CTRL/C aborted input - some data may be lost");
		return eve$learn_abort;
	[OTHERWISE]:
		return eve$learn_abort;
endon_error;
prompt := " Input file: ";
file_name := read_line(prompt);						! Get name of file to include
if file_name = atg$x_empty then
	atg$message("No file name specified");
	return;
endif;
edit(file_name,upper,collapse);						! Clean up the file name
if eve$is_wildcard(file_name) then					! If there were some wildcards...
	eve$reset_file_search;						! Reset the wildcard search
	temp_file_name := file_parse(file_name);			! Set up search buffer
	file_found := " found";						! Say no files found initially
	loop
		temp_file_name := file_search(file_name);		! Get next file name
		exitif temp_file_name = atg$x_empty;			! No more files to look at
		file_found := " selected";				! Say at least one file found
		response := read_line(prompt+temp_file_name+" [No] ?");	! Get a response from the user
		edit(response,upper,collapse);				! Clean up the response
		if length(response) = 0 then				! Default the response
			response := "No";				! ...to "NO"
		endif;
		exitif substr("YES",1,length(response)) = response;	! Exit if this one chosen
	endloop;
	if temp_file_name = atg$x_empty then				! If noting selected then...
		atg$message("No files matching "+file_name+file_found);
		return;
	endif;
	file_name := temp_file_name;					! Save the selected file name
endif;
buffer_name := read_line(prompt + file_name + "   Buffer: ");		! Get name of buffer to include it into
if buffer_name = atg$x_empty then					! Default buffer name to FILENAME.TYPE
	buffer_name := file_parse(file_name,atg$x_empty,atg$x_empty,NAME,TYPE);
	atg$message("Buffer name set to "+buffer_name);			! Tell user we defaulted the filename
endif;
buffer_name_length := length(buffer_name);
if substr(buffer_name,buffer_name_length,1) = "." then			! If buffer name ended in a "."...
	buffer_name := substr(buffer_name,1,buffer_name_length-1);	! ...remove the "."
	include_at_top := 0;						! ...and say that we must include at current position
else
	include_at_top := 1;						! ...otherwise include file at top of buffer
endif;
if buffer_name = atg$x_empty then					! If buffer name is now blank...
	buffer_ptr := current_buffer;					! ...include into the current buffer
else
	buffer_ptr := atg$find_buffer(buffer_name);			! ...otherwise locate the specified buffer
	if buffer_ptr = 0 then
		return;
	endif;
endif;
atg$set_buffer_filename(buffer_ptr,file_name);				! Save the filename for this buffer
atg$map_buffer(buffer_ptr);						! ...and switch to it
if include_at_top then							! If the user wanted to include at the top...
	position(beginning_of(current_buffer));				! ...move to the top of the buffer
else
	position(mark(none));						! ...else stay at the current editing position
endif;
read_file(file_name);							! Read in the file
endprocedure

!
! GOLD L	switch to last buffer
!
procedure atg$switch_to_last
atg$map_buffer(atg$x_last_buffer_ptr);					! Switch to last used buffer
endprocedure

!
! GOLD M	switch to buffer MAIN
!
procedure atg$switch_to_main
local	buffer_ptr;
buffer_ptr := atg$find_buffer(atg$x_main_buffer_name);			! Locate the main buffer
if buffer_ptr = 0 then
	return;
endif;
atg$map_buffer(buffer_ptr);						! ...and switch to it
endprocedure

!
! GOLD O	output the named buffer to a file
!
procedure atg$output_buffer
local	file_name,
	buffer_ptr,
	buffer_name,
	prompt;
on_error
	[TPU$_CONTROLC]:
		atg$message("CTRL/C aborted output - some data may be lost");
		return eve$learn_abort;
	[OTHERWISE]:
		return eve$learn_abort;
endon_error;
prompt := " Buffer: ";
buffer_name := read_line(prompt);					! Get name of buffer to output
edit(buffer_name,upper,collapse);					! Clean up the buffer name
if buffer_name = atg$x_empty then					! Default to current buffer
	buffer_ptr := current_buffer;
	buffer_name := get_info(buffer_ptr,"name");
else
	buffer_ptr := atg$find_buffer(buffer_name);			! Locate specified buffer
	if buffer_ptr = 0 then
		return;
	endif;
endif;
file_name := read_line( prompt + buffer_name + "   Output file: ");	! Get name of file to output
if file_name = atg$x_empty then						! Default file name to buffer name
	file_name := buffer_name;
endif;
file_name := file_parse(file_name,"SYS$DISK:[];",buffer_name,NODE,DEVICE,DIRECTORY,NAME,TYPE,VERSION); ! Fill in default fields
write_file(buffer_ptr,file_name);					! Output the buffer to the file
endprocedure

!
! GOLD P	toggle buffer modifiable flag
!
procedure atg$toggle_modifiable
local	buffer_ptr,
	buffer_name,
	state,
	prompt;
on_error
	[OTHERWISE]:
endon_error;
prompt := " Buffer: ";
buffer_name := read_line(prompt);
edit(buffer_name,upper,collapse);
if buffer_name = atg$x_empty then
	buffer_ptr := current_buffer;
	buffer_name := get_info(buffer_ptr,"name");
else
	buffer_ptr := atg$find_buffer(buffer_name);
	if buffer_ptr = 0 then
		return;
	endif;
endif;
if get_info(buffer_ptr,"modifiable") then				! If the buffer can be modified...
	set(modifiable,buffer_ptr,off);					! Mark buffer as un-modifiable
	state := ' cannot';
else
	set(modifiable,buffer_ptr,on);					! Mark buffer as modifiable
	state := ' can';
endif;
atg$message('Buffer '+buffer_name+state+' now be modified');		! Tell the user what's been done
eve$update_status_lines;						! Update all EVE status lines
endprocedure

!
! GOLD Q	quit from the editor
!
procedure atg$quit
quit;									! QUIT from TPU
endprocedure

!
! GOLD R	mark named buffer as read-only/non-writeable
!
procedure atg$make_buffer_readonly
local	buffer_ptr,
	buffer_name;
on_error
	[OTHERWISE]:
endon_error;
buffer_name := read_line(" Buffer: ");					! Get the buffer name
edit(buffer_name,upper,collapse);					! Clean up the name
if buffer_name = atg$x_empty then					! Default to the current buffer
	buffer_ptr := current_buffer;
	buffer_name := get_info(buffer_ptr,"name");
else
	buffer_ptr := atg$find_buffer(buffer_name);			! ...else locate the specified buffer
	if buffer_ptr = 0 then
		return;
	endif;
endif;
set(no_write,buffer_ptr,on);						! Say the buffer is not writeable
atg$message('Buffer '+buffer_name+' will not be written' );		! Tell the user what's happened
eve$update_status_lines;						! Update all EVE status lines
endprocedure

!
! GOLD S	list all our buffers
!
! List all the buffers in use, what state they are in, and what file(s) are associated with them.
! Use the cusor keys to select the buffer to go to.
! This is also called from GOLD B when no buffer name is specified.
!
procedure atg$show_buffers
local	buffer_ptr,
	buffer_name,
	this_buffer,
	file_name,
	buffer_name_array,
	buffer_ptr_array,
	row_array,
	max_row,
	the_row,
	the_range,
	saved_buffer;
on_error
	[OTHERWISE]:
		if current_window = atg$x_show_window then		! If we are looking at the menu...
			unmap(atg$x_show_window);			! Get rid of display window (old window now mapped)
		endif;
		if current_buffer <> saved_buffer then			! If the wrong buffer is mapped...
			atg$map_buffer(saved_buffer);			! ...map the old buffer
		endif;
		delete(buffer_ptr_array);				! Reclaim memory from local arrays
		delete(buffer_name_array);
		delete(row_array);
		set(timer,on);						! Turn timer message on now
		return eve$learn_abort;
endon_error;
saved_buffer := current_buffer;						! Remember the current buffer (so we can flag it)
row_array	  := create_array;					! Marks for start of each row
buffer_ptr_array  := create_array;					! => buffer on each row
buffer_name_array := create_array;					! Name of buffer on each row
set(timer,off);								! Turn timer message off for a while
max_row := 0;								! Number of lines in buffer list (= # of buffers)
erase(atg$x_show_buffer);						! Start with clean buffer
set(width,atg$x_show_window,get_info(screen,"width"));			! Make sure window is same width as screen
map(atg$x_show_window,atg$x_show_buffer);				! Make the window visible, and the buffer current
copy_text("   Buffer Name           Lines      File");			! Display header
split_line;
copy_text("   -----------           -----      ----");  
split_line;
buffer_ptr := get_info(buffers,"first");				! => First buffer in list of buffers
loop
	exitif buffer_ptr = 0;						! Exit if no more buffers
	buffer_name := get_info(buffer_ptr,"name");			! Get name of buffer
	if (buffer_ptr = saved_buffer) or (buffer_name = atg$x_main_buffer_name) or not get_info(buffer_ptr,"system") then
		max_row := max_row + 1;					! Say one more buffer to display
		buffer_ptr_array{max_row} := buffer_ptr;		! Save => to buffer
		buffer_name_array{max_row} := buffer_name;		! Save buffer name
		if get_info(buffer_ptr,"no_write") then
			this_buffer := "R";				! Read-only buffer
		else
			this_buffer := "W";				! Read-write buffer
		endif;
		if get_info(buffer_ptr,"modified") then
			this_buffer := this_buffer + "M";		! Buffer has been modified
		else
			this_buffer := this_buffer + " ";		! Buffer has not been modified
		endif;
		if buffer_ptr = saved_buffer then
			this_buffer := this_buffer + "=";		! Flag current buffer
			the_row := max_row;				! And remember what row its on
		else
			this_buffer := this_buffer + " ";
		endif;
		case atg$get_buffer_filename(buffer_ptr,file_name)
			[-1]:						! Output file
			[0]:						! No file
			[1]:	file_name := "(" + file_name + ")";	! Input file
		endcase;
		row_array{max_row} := copy_text(fao("!3AS!20AS !6UL      !AS",this_buffer,buffer_name,
			get_info(buffer_ptr,"record_count"), file_name ));
		split_line;
	endif;
	buffer_ptr := get_info(buffers,"next");				! Get => to next buffer in chain
endloop;
loop
	position(row_array{the_row});					! Move to start of current buffer row
	move_horizontal(length(this_buffer));				! Skip over the intro characters
	the_range := search_quietly(buffer_name_array{the_row},forward,exact); ! Locate the buffer name in the line
	the_range := create_range(beginning_of(the_range),end_of(the_range),bold); ! Highlight the buffer name
	position(the_range);						! Move to start of select region
	update(atg$x_show_window);					! Make the screen reflect the changes
	case key_name(read_key)						! Get a key from the user
		[E4,ENTER,RET_KEY]:				! SELECT, ENTER or RETURN...
			exitif 1 = 1;					! ...selection has been made, leave
		[E5,UP]:					! PREVIOUS_SCREEN, Cursor UP
			if the_row > 1 then				! If not on first row...
				the_row := the_row - 1;			! ...move up one row
			else
				the_row := max_row;			! ...else wrap from first row to last
			endif;
		[E6,DOWN]:					! NEXT_SCREEN, Cursor DOWN
			if the_row < max_row then			! If we are not on the last row...
				the_row := the_row + 1;			! ...move down one row
			else
				the_row := 1;				! ...else wrap from last to first row
			endif;
	endcase;
endloop;
unmap(atg$x_show_window);						! Get rid of display window (old window now mapped)
atg$map_buffer(buffer_ptr_array{the_row});				! Map the selected buffer
delete(buffer_ptr_array);						! Reclaim memory from local arrays
delete(buffer_name_array);
delete(row_array);
set(timer,on);								! Turn timer message on now
endprocedure

!
! GOLD V	Show our current version
!
procedure atg$show_version
atg$message("Version: " + eve$version);
endprocedure
!
! F19, CTRL/P		copy select to named buffer
! GOLD F19, GOLD CTRL/P	cut select to named buffer
!
procedure atg$select_to_buffer( cut_flag )
local	buffer_name,
	buffer_ptr,
	prompt,
	the_position,
	the_range;
on_error
	[TPU$_NOSELECT,TPU$_SELRANGEZERO]:
		atg$message("No current select range");
		return eve$learn_abort;
	[OTHERWISE]:
		return eve$learn_abort;
endon_error;
the_range := select_range;						! Locate current select range
if cut_flag then
	prompt := " Cut";
else
	prompt := " Copy";
endif;
buffer_name := read_line(prompt + " to buffer: ");
if buffer_name = atg$x_empty then
	atg$message("No buffer name specified");
	return;
endif;
buffer_ptr := atg$find_buffer(buffer_name);				! Locate the specified buffer
if buffer_ptr = 0 then
	return;
endif;
the_position := mark(none);						! Remember where we are
position(buffer_ptr);							! Move editing position to the new buffer
if cut_flag then							! If we want to CUT the SELECT region...
	move_text(the_range);						! Cut the text to the new buffer
	atg$message("SELECT region cut to "+buffer_name);		! Tell the user what happened
else
	copy_text(the_range);						! Copy the text to the new buffer
	atg$message("SELECT region copied to "+buffer_name);		! Tell the user what happened
endif;
position(the_position);							! Move back to where we were
eve$x_select_position := 0;						! Reset EVE select region
endprocedure

!
! GOLD W	mark named buffer as writeable
!
procedure atg$make_buffer_writeable
local	file_name,
	buffer_ptr,
	buffer_name,
	prompt;
on_error
	[OTHERWISE]:
endon_error;
prompt := " Buffer: ";
buffer_name := read_line(prompt);
edit(buffer_name,upper,collapse);
if buffer_name = atg$x_empty then
	buffer_ptr := current_buffer;
	buffer_name := get_info(buffer_ptr,"name");
else
	buffer_ptr := atg$find_buffer(buffer_name);
	if buffer_ptr = 0 then
		return;
	endif;
endif;
file_name := read_line( prompt + buffer_name + "   Output file: ");
if file_name = atg$x_empty then						! If no file name specified...
	file_name := buffer_name;					! ...use the buffer name
endif;
file_name := file_parse(file_name,"SYS$DISK:[];",buffer_name,NODE,DEVICE,DIRECTORY,NAME,TYPE,VERSION); ! Fill in default fields
if eve$is_wildcard(file_name) then					! If there were wildcards in the name...
	atg$message("Cannot write a wildcard filename");		! ...stop going any further
	return;
endif;
set(no_write,buffer_ptr,off);						! Mark buffer as writeable
set(output_file,buffer_ptr,file_name);					! Set the name of the file to write
set(modified,buffer_ptr,on);						! Say buffer modified so it will be written
atg$message('Buffer '+buffer_name+' will be written to '+file_name );	! Tell the user what's been done
eve$update_status_lines;						! Update all EVE status lines
endprocedure

!
! GOLD CTRL/W	Swap screen width
!
procedure atg$swap_screen_width
if atg$x_screen_width = 132 then					! If screen width is currently 132...
	atg$set_screen_width(80);					! ...set the screen to 80 columns
else
	atg$set_screen_width(132);					! ...else set it to 132 columns
endif;
endprocedure
!
! The procedure sets the screen width for each TPU window.
! All windows must be the same wwidth for the screen width to change.
!
procedure atg$set_screen_width(new_width)
local	loop_window;
loop_window := get_info(windows,"first");				! Get => to first window
loop
	exitif loop_window = 0;						! Exit if no more windows
	set(width,loop_window,new_width);				! Set the width of this window
	loop_window := get_info(windows,"next");			! Get => to next window in list
endloop;
atg$x_screen_width := new_width;					! Remember the new screen width
set(right_margin,current_buffer,new_width);				! Make sure margin is correct
eve$update_status_lines;						! Update all EVE status lines
endprocedure

!
! GOLD .	set mark
!
procedure atg$set_mark
copy_text(atg$x_text_marker);						! Drop the special marker in
endprocedure
!
! F18		set EVE marker
!
procedure atg$set_eve_mark
if not eve_mark(atg$x_empty) then					! Call EVE to do the work
	return eve$learn_abort;
endif;
endprocedure
!
! GOLD /	find mark
!
procedure atg$find_mark
local	mark_pos;
on_error
	[TPU$_STRNOTFOUND]:
		atg$message("Marker not found");
		return eve$learn_abort;
	[OTHERWISE]:
		return eve$learn_abort;
endon_error;
mark_pos := search(atg$x_text_marker,get_info(current_buffer,"direction"),EXACT); ! Look for the marker
position(mark_pos);							! Move the editing position to the marker
erase(mark_pos);							! ...and delete the marker
endprocedure
!
! GOLD F18	go to EVE marker
!
procedure atg$find_eve_mark
if not eve_go_to(atg$x_empty) then					! Call EVE to do the work
	return eve$learn_abort;
endif;
endprocedure

!
! GOLD $	spawn a sub process
!
procedure atg$spawn
spawn;									! Start the sub process
endprocedure
!
! GOLD ^	execute DCL command
!
procedure atg$spawn_dcl_command
local	process_id,
	dcl_buffer,
	dcl_command;
on_error
	[OTHERWISE]:
endon_error;
dcl_command := read_line(" DCL command: ");				! Read the DCL command to execute
if dcl_command = atg$x_empty then					! If no command...
	atg$message("No command specified");				! ...say so
	return;
endif;
dcl_buffer := create_buffer("$DCL_BUFFER$");				! Create a buffer to hold DCL output
set(right_margin,dcl_buffer,get_info(current_window,"width"));		! Make sure margin is correct
process_id := create_process(dcl_buffer,dcl_command);			! Create a process to execute command
delete(process_id);							! Remove the process
copy_text(dcl_buffer);							! Insert the DCL output into current buffer
delete(dcl_buffer);							! Remove the DCL buffer
endprocedure

!
! GOLD F17	Toggle between 1 or 2 windows
!
procedure atg$swap_window_count
if eve$x_number_of_windows <> 1 then					! If there is more than one window currently...
	eve_one_window;							! ...drop back to only one window
else
	eve_two_windows;						! ...else split to two windows
endif;
set(scrolling,current_window,on,atg$x_top_margin,atg$x_bottom_margin,0); ! Keep editing point near middle of screen
endprocedure
!
! F19		Insert current date (what happns with VMS V5 variable format dates?)
! GOLD F19	Insert current time
!
procedure atg$get_date_time( time_flag )
local	date	,
	temp	;
if time_flag then							! Time wanted
	copy_text(substr(fao("!%T",0),1,5));				! Insert formatted time in current buffer
else
	date := fao("!%D",0);						! Get date in form "dd-MMM-YYYY"
	temp := substr(date,5,2); edit(temp,lower);			! Make last two characters of month lower case
	date := substr(date,1,4) + temp + "-" + substr(date,10,2);	! date now in form "dd-Mmm-YY"
	if substr(date,1,1) = " " then					! If day is < 10 (leading " " in date)...
		date := "0" + substr(date,2,8);				! ...replace the " " with a "0"
	endif;
	copy_text(date);						! Insert formatted date in current buffer
endif;
endprocedure

! F20		Locate current line
!
procedure atg$where
local	count, line;
count := get_info(current_buffer,"record_count");			! Maximum line number
if count = 0 then
	atg$message( "No lines in buffer" );
else
	line :=	get_info(mark(NONE),"record_number");			! Current line number
	if mark(NONE) = end_of(current_buffer) then			! If we are at the buffer's end...
		line := count;						! ...use buffer line count
	endif;								! (because at end, line = count + 1!!!)
	atg$message( fao( "Line !UL of !UL (!UL%)", line, count, (line*100)/count ) );
endif;
endprocedure;

!
! Locate the passed buffer name.
! If the buffer is not found, create it.
! If we fail to create the buffer, return 0, else return the buffer pointer.
!
procedure atg$find_buffer( buffer_name )
local	clean_name,
	buffer_ptr;
on_error
	return 0;
endon_error;
clean_name := buffer_name;
edit(clean_name,upper,collapse);					! Tidy up the buffer name
if clean_name = "MAIN" then						! For compatability with "old" EDT...
	clean_name := atg$x_main_buffer_name;				! ...replace "MAIN" wwith real main buffer name
endif;
if clean_name = "PASTE" then						! For compatability with "old" EDT...
	return paste_buffer;						! ...return => to TPU paste buffer
endif;
buffer_ptr := get_info(BUFFERS,"find_buffer",clean_name);		! Locate the named buffer
if buffer_ptr = 0 then							! If we can't find the buffer...
	buffer_ptr := atg$create_buffer(buffer_name);			! ...try to create it
endif;
return buffer_ptr;							! Return => to located/created buffer
endprocedure
!
! Create a new buffer.
! Return a pointer to the new buffer.
!
procedure atg$create_buffer( buffer_name )
local	buffer_ptr;
on_error
	atg$message('Failed to create new buffer "'+buffer_name+'"');
	return 0;
endon_error;
edit(buffer_name,upper,collapse);					! Clean up buffer name
buffer_ptr := create_buffer(buffer_name);				! Create the new buffer
set(right_margin,buffer_ptr,get_info(current_window,"width"));		! Make sure margin is correct
set(no_write,buffer_ptr,on);						! Say that its not writeable
set(eob_text,buffer_ptr,"[End of " + buffer_name + "]");		! Set a nice end-of-buffer marker
return buffer_ptr;							! Return => to created buffer
endprocedure
!
! Print an ATG message
!
procedure atg$message( what )
set(bell,all,on);							! Make the bell ring
message(atg$x_message_prefix + what );					! Display a message with our prefix
set(bell,all,off);							! Turn off the bell...
set(bell,broadcast,on);							! ...but enable it for broadcast messages
endprocedure
!
! Map the specified buffer in the current window.
! As we are integrated with EVE, we call the EVE routine to update the status lines
! If we have changed buffers, then save the last buffer pointer so we can switch back to it with GOLD L.
!
procedure atg$map_buffer( buffer_ptr )
local	temp_ptr;
temp_ptr := current_buffer;						! Remember our current buffer
set(right_margin,buffer_ptr,get_info(current_window,"width"));		! Make sure margin is correct
map(current_window,buffer_ptr);						! Make passed buffer the current buffer
position(mark(none));							! Position cursor correctly in window
eve$update_status_lines;						! Update all EVE status lines
if temp_ptr <> buffer_ptr then						! If we have really changed the buffer...
	atg$x_last_buffer_ptr := temp_ptr;				! ...remember the old buffer (for GOLD L)
endif;
endprocedure

!
! Associate the passed filename with the passed buffer name
!
procedure atg$set_buffer_filename( buffer_ptr, file_name )
on_error
	[OTHERWISE]:
endon_error;
if file_name <> atg$x_empty then
	file_name := file_parse(file_name,"SYS$DISK:[];",atg$x_empty,NODE,DEVICE,DIRECTORY,NAME,TYPE,VERSION);
endif;
atg$x_input_file{buffer_ptr} := file_name;
endprocedure
!
! Return the file name associated with a buffer
!
! Return:	-1 + file_name	Output file name
!		0		No file name
!		1 + file_name	Input file name
!
procedure atg$get_buffer_filename( buffer_ptr, file_name )
local	file_name_1;
if atg$x_input_file = TPU$K_UNSPECIFIED then				! If there is no buffer array...
	atg$x_input_file := create_array;				! Array of input files (GOLD I)
endif;
if atg$x_input_file{buffer_ptr} = TPU$K_UNSPECIFIED then		! If there is no buffer filename...
	atg$set_buffer_filename(buffer_ptr,get_info(buffer_ptr,"file_name"));
endif;
if get_info(buffer_ptr,"no_write") then					! If its a read-only buffer
	file_name := atg$x_input_file{buffer_ptr};			! ...try for an input filename
	if file_name <> atg$x_empty then				! If there was one...
		return 1;						! ...return success
	else
		return 0;						! ...say no name to return
	endif;
endif;
file_name_1 := get_info(buffer_ptr,"output_file");
if get_info(file_name_1,"type") = STRING then
	file_name := file_name_1;
else
	file_name := get_info(buffer_ptr,"file_name");
endif;
if file_name <> atg$x_empty then
	file_name := file_parse(file_name,"SYS$DISK:[];",atg$x_empty,NODE,DEVICE,DIRECTORY,NAME,TYPE,VERSION);
	return -1;
else
	return 0;
endif;
endprocedure

!
! Define all the ATG key definitions
!
procedure atg$define_environment
!
! Special character keys
!
define_key("atg$set_mark",			key_name(".",shift_key),	"Insert special marker");
define_key("atg$find_mark",			key_name("/",shift_key),	"Locate special marker");
define_key("atg$spawn",				key_name("$",shift_key),	"Spawn sub-process");
define_key("atg$spawn_dcl_command",		key_name("^",shift_key),	"Execute DCL command");
!
! Alphabetic keys
!
define_key("atg$switch_buffer",			key_name("b",shift_key),	"Switch to named buffer");
define_key("atg$include",			key_name("i",shift_key),	"Include file in a buffer");
define_key("atg$switch_to_last",		key_name("l",shift_key),	"Switch to last buffer");
define_key("atg$switch_to_main",		key_name("m",shift_key),	"Switch to main buffer");
define_key("atg$output_buffer",			key_name("o",shift_key),	"Output buffer to a file");
define_key("atg$toggle_modifiable",		key_name("p",shift_key),	"Toggle modifiable");
define_key("atg$quit",				key_name("q",shift_key),	"Quit from editor");
define_key("atg$make_buffer_readonly",		key_name("r",shift_key),	"Make a buffer read-only");
define_key("atg$show_buffers",			key_name("s",shift_key),	"Show list of buffers");
define_key("atg$show_version",			key_name("v",shift_key),	"Show version");
define_key("atg$make_buffer_writeable",		key_name("w",shift_key),	"Make buffer writeable");
!
! Control keys
!
define_key("atg$erase_and_paste_buffer",	key_name(ctrl_g_key,shift_key),	"Delete SELECT/Paste buffer");
define_key("atg$paste_buffer",			key_name(ctrl_g_key),		"Paste named buffer");
define_key("atg$select_to_buffer(0)",		key_name(ctrl_p_key),		"Copy SELECT to buffer");
define_key("atg$select_to_buffer(1)",		key_name(ctrl_p_key,shift_key),	"Cut SELECT to buffer");
define_key("atg$swap_screen_width",		key_name(ctrl_w_key,shift_key),	"Toggle 80/132 width");
!
! Function keys
!
define_key("atg$paste_buffer",			F7,				"Insert buffer");
define_key("atg$erase_and_paste_buffer",	key_name(F7,shift_key),		"Replace SELECT with buffer");
define_key("atg$select_to_buffer(0)",		F8,				"Copy SELECT to buffer");
define_key("atg$select_to_buffer(1)",		key_name(F8,shift_key),		"Cut SELECT to buffer");

define_key("eve_next_window",			F17,				"Next window");
define_key("atg$swap_window_count",		key_name(F17,shift_key),	"Toggle windows (1 or 2)");
define_key("atg$set_eve_mark",			F18,				"Insert EVE marker");
define_key("atg$find_eve_mark",			key_name(F18,shift_key),	"Locate EVE marker");
define_key("atg$get_date_time(0)",		F19,				"Insert date");
define_key("atg$get_date_time(1)",		key_name(F19,shift_key),	"Insert time");
define_key("atg$where",				F20,				"Locate position");
!
endprocedure

!
! Trailing code that EVE$BUILD sets up in the generated section
!
constant atg$x_message_prefix := "%ATG, ";				! Prefix for our messages
constant atg$x_empty := "";						! Null string

atg$define_environment;							! Define ATG environment
compile("procedure atg$define_environment endprocedure");		! Make it a nop

eve$set_edt_keypad;							! Set EDT emulation keypad keys
!