!

PROCEDURE lst$init_variables
!
	TRUE := 1;
	FALSE := 0;
!
	lst$x_cut_empty := TRUE;
	lst$x_exit_flag := TRUE;
	lst$x_primary := TRUE;
	lst$x_screen_split := FALSE;
	lst$xs_initialize := TRUE;
	lst$xs_beginning_of_select := FALSE;
	lst$x_initialize := TRUE;
	lst$x_null :='';
	lst$x_search_string := lst$x_null;
	lst$x_search_case := NO_EXACT;
	lst$x_beginning_of_select := FALSE;
	lst$x_search_range := FALSE;
	lst$x_select_range := FALSE;
	lst$x_blanks := '                                                ';
	lst$x_max_name_length := 58;
!
ENDPROCEDURE
!

!
PROCEDURE lst$help
!
	LOCAL	var,
		save_current;
!
	save_current := CURRENT_BUFFER;
!
	SET ( PROMPT_AREA, ( lst$x_screen_length ), 1, REVERSE );
!
	MAP ( lst$help_window, lst$help_buffer );
	POSITION ( lst$help_buffer );
	HELP_TEXT ( "SYS$HELP:LISTHELP.HLB", "HELP", OFF, lst$help_buffer );
	UPDATE ( lst$help_window );
	var := READ_LINE ( "			 Hit any key to resume LIST ", 1 );
	ERASE ( lst$help_buffer );
	UPDATE ( lst$help_window );
	UNMAP ( lst$help_window );
!
!
	IF LAST_KEY = CTRL_Z_KEY THEN
!
	    lst$exit;
!
	ENDIF;
!
	SET ( PROMPT_AREA, ( lst$x_screen_length - 2 ), 1, REVERSE );
!
	POSITION ( save_current );
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$bad_key ( key )
!
	LOCAL	key,	user_buffer;
!
	MESSAGE ( "" );
	SET(SCREEN_UPDATE, OFF);
	user_buffer := CURRENT_BUFFER;
	POSITION ( MESSAGE_BUFFER );
	SCROLL( MESSAGE_WINDOW, -1 );
	SET(SCREEN_UPDATE, ON);
	UPDATE(CURRENT_WINDOW);
	POSITION ( END_OF(MESSAGE_BUFFER) );
	MOVE_VERTICAL(  -1 );
	ERASE_LINE;
!
	POSITION ( user_buffer );
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$page
!
	LOCAL	dir,
		beginning_of_line,
		next_page;
!
	ON_ERROR
!
	IF ERROR = TPU$_STRNOTFOUND THEN
!
	    IF dir = REVERSE THEN
!
		POSITION ( BEGINNING_OF ( CURRENT_BUFFER ) )
!
	    ELSE
!
		POSITION ( END_OF ( CURRENT_BUFFER ) )
!
	    ENDIF;
!
	ENDIF;
!
	RETURN;
!
	ENDON_ERROR
!
	dir := CURRENT_DIRECTION;
!
	IF dir = FORWARD THEN
!
	    MOVE_HORIZONTAL ( 1 )
!
	ELSE
!
	    MOVE_HORIZONTAL ( -1 )
!
	ENDIF;
!
	next_page := SEARCH ( ASCII ( 12 ), dir );
	POSITION ( END_OF ( next_page ) );
!
ENDPROCEDURE
!

!
PROCEDURE lst$section ( direction_to_move )
!
    LOCAL	offset,
		direction_to_move;
!
	offset := CURRENT_OFFSET;
	MOVE_HORIZONTAL ( -offset );
!
	IF direction_to_move = FORWARD THEN
!
	    MOVE_VERTICAL ( lst$x_section_distance )
!
	ELSE
!
	    MOVE_VERTICAL ( -lst$x_section_distance )
!
	ENDIF;
!
ENDPROCEDURE
!

!
PROCEDURE lst$search
!
	LOCAL	search_term,
		direction_distance,
		beginning_of_line,
		saved_position;
!
	ON_ERROR
!
	    saved_error := ERROR;
!
	    IF	( ERROR = TPU$_STRNOTFOUND )	OR
		( ERROR = TPU$_BEGOFBUF )	OR
		( ERROR = TPU$_ENDOFBUF )	THEN
!
		MESSAGE ( """" + lst$x_search_string + """ not found " );
!
		IF saved_position <> 0 THEN
!
		    POSITION ( saved_position );
		    RETURN;
!
		ENDIF;
!
		IF ( saved_error = TPU$_BEGOFBUF )	OR
		   ( saved_error = TPU$_ENDOFBUF )	THEN
!
		    RETURN;
!
		ENDIF;
!
	    ENDIF;
!
	ENDON_ERROR
!
!	Get the string to search for
!
	lst$x_search_string := READ_LINE ( 'Search for: ' );
!
	IF ( CURRENT_DIRECTION = FORWARD ) THEN
!
	    direction_distance := 1;
!
	ELSE
!
	    direction_distance := -1;
!
	ENDIF;
!
	IF ( LAST_KEY = KP5 ) THEN
!
	    SET ( REVERSE, CURRENT_BUFFER );
	    IF MARK ( NONE ) = BEGINNING_OF ( CURRENT_BUFFER ) THEN
!
		MESSAGE ( """" + lst$x_search_string + """ not found " );
		RETURN
!
	    ENDIF;
!
	    direction_distance := -1;
!
	ELSE
!
	    IF LAST_KEY = KP4 THEN
!
		SET ( FORWARD, CURRENT_BUFFER );
!
		IF MARK ( NONE ) = END_OF ( CURRENT_BUFFER ) THEN
!
		    MESSAGE ( """" + lst$x_search_string + """ not found " );
		    RETURN;
!
		ENDIF;
!
		direction_distance := 1;
!
	    ENDIF;
!
	ENDIF;
!
	saved_position := MARK ( NONE );
!
	MOVE_HORIZONTAL ( direction_distance );
!
	lst$x_search_range := SEARCH ( lst$x_search_string, CURRENT_DIRECTION,
					lst$x_search_case );
!
	IF ( lst$x_search_range <> 0 ) THEN
!
	    POSITION ( BEGINNING_OF ( lst$x_search_range ) );
!
	ELSE
!
	    MOVE_HORIZONTAL ( -direction_distance );
!
	ENDIF;
!
ENDPROCEDURE
!

!
PROCEDURE lst$search_next
!
	LOCAL	direction_distance,
		saved_position;
!
	ON_ERROR
!
	    IF ERROR = TPU$_STRNOTFOUND THEN
!
		MESSAGE ( """" + lst$x_search_string + """ not found " );
!
		IF saved_position <> 0 THEN
!
		    POSITION ( saved_position );
		    RETURN;
!
		ENDIF;
!
	    ENDIF;
!
	ENDON_ERROR
!
	IF CURRENT_DIRECTION = FORWARD THEN
!
	    IF ( MARK ( NONE ) = END_OF ( CURRENT_BUFFER ) ) THEN
!
		MESSAGE ( """" + lst$x_search_string + """ not found " );
		RETURN;
!
	    ENDIF;
!
	    direction_distance := 1;
!
	ELSE
!
	    IF ( MARK ( NONE ) = BEGINNING_OF ( CURRENT_BUFFER ) ) THEN
!
		MESSAGE ( """" + lst$x_search_string + """ not found " );
		RETURN;
!
	    ENDIF;
!
	    direction_distance := -1;
!
	ENDIF;
!
	MOVE_HORIZONTAL ( direction_distance );
!
	lst$x_search_range := SEARCH ( lst$x_search_string, CURRENT_DIRECTION,
					lst$x_search_case );
!
	IF ( lst$x_search_range <> 0 ) THEN
!
	    POSITION ( BEGINNING_OF ( lst$x_search_range ) );
!
	ELSE
!
	    MOVE_HORIZONTAL ( -direction_distance );
!
	ENDIF;
!
ENDPROCEDURE
!

!
PROCEDURE lst$up_arrow
!
	LOCAL	offset;
!
	offset := CURRENT_OFFSET;
	MOVE_HORIZONTAL ( -offset );
!
	If offset = 0 THEN
!
	    MOVE_VERTICAL ( -1 );
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

PROCEDURE lst$next_line ( dir )
!
	LOCAL dir;
!
	IF dir = REVERSE THEN
	    lst$up_arrow;
	ELSE
	    lst$down_arrow;
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$down_arrow
!
	LOCAL	offset;
!
	offset := CURRENT_OFFSET;
	MOVE_HORIZONTAL ( -offset );
	MOVE_VERTICAL ( 1 );
!
ENDPROCEDURE
!

!
PROCEDURE lst$print_file
!
	LOCAL	lst$name,
		lst$type;
!
	IF lst$x_primary THEN
!
	    lst$name := FILE_PARSE ( lst$x_primary_filename, ' ', ' ', NAME );
	    lst$type := FILE_PARSE ( lst$x_primary_filename, ' ', ' ', TYPE );
!
	    IF lst$x_beginning_of_select <> 0 THEN
!
		WRITE_FILE ( SELECT_RANGE, 'SYS$PRINT:' + lst$name + lst$type );
		lst$x_beginning_of_select := 0;
!
	    ELSE
!
		WRITE_FILE ( CURRENT_BUFFER, 'SYS$PRINT:' + lst$name + lst$type );
!
	    ENDIF;
!
	ELSE
!
	    lst$name := FILE_PARSE ( lst$x_secondary_filename, ' ', ' ', NAME );
	    lst$type := FILE_PARSE ( lst$x_secondary_filename, ' ', ' ', TYPE );
!
	    IF lst$xs_beginning_of_select <> 0 THEN
!
		WRITE_FILE ( SELECT_RANGE, 'SYS$PRINT:' + lst$name + lst$type );
		lst$xs_beginning_of_select := 0;
!
	    ELSE
!
		WRITE_FILE ( CURRENT_BUFFER, 'SYS$PRINT:' + lst$name + lst$type );
!
	    ENDIF;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$write_file
!
	LOCAL	lst$name,
		lst$type;
!
	IF lst$x_cut_empty THEN
!
	    MESSAGE ( "Cut buffer is empty" );
!
	ELSE
!
	    lst$name := READ_LINE ( "Output filename for CUT buffer? " );
!
	    IF	( LAST_KEY <> CTRL_Z_KEY )	AND
		( lst$name <> lst$x_null )	THEN
!
		WRITE_FILE ( lst$cut_buffer, lst$name );
		lst$erase_cut_buffer;
!
	    ENDIF;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$erase_cut_buffer
!
	ERASE ( lst$cut_buffer );
	DELETE ( lst$cut_buffer );
	lst$cut_buffer := CREATE_BUFFER ( "CUT" );
	SET ( NO_WRITE, lst$cut_buffer, ON );
	lst$x_cut_empty := TRUE;
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$select
!
	IF lst$x_primary THEN
!
	    IF lst$x_beginning_of_select <> 0 THEN
!
		MESSAGE ( "Select is already active" );
!
	    ELSE
!
		lst$x_beginning_of_select := SELECT ( REVERSE );
!
	    ENDIF;
!
	ELSE
!
	    IF lst$xs_beginning_of_select <> 0 THEN
!
		MESSAGE ( "Select is already active" );
!
	    ELSE
!
		lst$xs_beginning_of_select := SELECT ( REVERSE );
!
	    ENDIF;
!

	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$set_status_line ( filename )
!
	LOCAL	name_length,
		dir,
		filename,
		file_name;
!
	IF GET_INFO ( CURRENT_BUFFER, "DIRECTION" ) = REVERSE THEN
!
	    dir := " BACKUP"
!
	ELSE
!
	    dir := "ADVANCE"
!
	ENDIF;
!
	name_length := LENGTH ( filename );
!
	If name_length > lst$x_max_name_length THEN
!
	    file_name := SUBSTR ( filename,
				  ( name_length - lst$x_max_name_length ),
				  lst$x_max_name_length );
!
	ELSE
!
	    file_name := filename +
			 SUBSTR ( lst$x_blanks, 1,
				  ( lst$x_max_name_length - name_length ) );
!
	ENDIF;
!
	SET ( STATUS_LINE, CURRENT_WINDOW, REVERSE,
			   "File: " + file_name + "        " + dir );
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$get_file
!
	IF ( NOT lst$x_primary ) THEN
!
	    lst$get_other_file;
	    RETURN;
!
	ENDIF;
!
	ERASE ( lst$primary_buffer );
!
	temp := FILE_SEARCH ( lst$input_file );
!
	IF temp = lst$x_null THEN
!
!	    Exit if we cannot find the file
!
	    IF lst$x_initialize = TRUE THEN
!
		MESSAGE ( 'Input file ' + lst$input_file + ' does not exist' );
!
	    ENDIF;
!
	    IF lst$x_exit_flag THEN
!
		lst$exit
!
	    ELSE
!
		RETURN;
!
	    ENDIF;
!
	ELSE
!
	    lst$x_primary_filename := temp;
!
	ENDIF;
!
	lst$set_status_line ( lst$x_primary_filename );
!
	READ_FILE ( lst$x_primary_filename );
!
!	Turn off select
!
	lst$x_beginning_of_select := 0;
!
!	Goto current position in the primary buffer
!
	POSITION ( BEGINNING_OF ( lst$primary_buffer ) );
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$get_other_file
!
	ERASE ( lst$secondary_buffer );
!
	temp := FILE_SEARCH ( lst$s_input_file );
!
	IF temp = lst$x_null THEN
!
!	    Exit if we cannot find the file
!
	    IF lst$xs_initialize = 1 THEN
!
		MESSAGE ( 'Input file ' + lst$s_input_file + ' does not exist' );
!
	    ENDIF;
!
	    lst$unsplit_screen;
!
	    RETURN;
!
	ELSE
!
	    lst$x_secondary_filename := temp;
!
	ENDIF;
!
	lst$set_status_line ( lst$x_secondary_filename );
!
	READ_FILE ( lst$x_secondary_filename );
!
!	Turn off select
!
	lst$xs_beginning_of_select := 0;
!
!	Goto current position in the primary buffer
!
	POSITION ( BEGINNING_OF ( lst$secondary_buffer ) );
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$show_cut
!
	IF lst$x_screen_split THEN
!
	    MESSAGE ( "Already in split screen mode" );
!
	ELSE
!
	    IF lst$x_cut_empty THEN
!
		MESSAGE ( "CUT buffer is currently empty" );
!
	    ELSE
!
		lst$x_screen_split := TRUE;
!
		ADJUST_WINDOW ( lst$primary_window, 0, -10 );
!
!		Create the secondary buffer and window
!
		lst$secondary_buffer := CREATE_BUFFER ( "SECONDARY" );
		lst$secondary_window := CREATE_WINDOW ( 12,
					(lst$x_screen_length - 14 ), ON );
!
		SET ( NO_WRITE, lst$secondary_buffer, ON );
		SET ( EOB_TEXT, lst$secondary_buffer, "[End of file]" );
		SET ( SYSTEM, lst$secondary_buffer );
		SET ( SCROLLING, lst$secondary_window, ON, 10, 10, 0 );
		MAP ( lst$secondary_window, lst$secondary_buffer );
!
		lst$x_primary := FALSE;
		lst$x_section_distance := 8;
!
		lst$x_secondary_filename := "CUT buffer";
!
		lst$set_status_line ( lst$x_secondary_filename );
!
!		Turn off select
!
		lst$xs_beginning_of_select := 0;
!
		POSITION ( BEGINNING_OF ( lst$secondary_buffer ) );
		COPY_TEXT ( lst$cut_buffer );
!
!		Goto current position in the buffer
!
		POSITION ( BEGINNING_OF ( lst$secondary_buffer ) );
!
	    ENDIF;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$direction ( direction )
!
	LOCAL	direction;
!
	IF direction = 1 THEN
!
	    IF GET_INFO ( CURRENT_BUFFER, "DIRECTION" ) = REVERSE THEN
!
		SET ( FORWARD, CURRENT_BUFFER );
!
	    ELSE
!
		RETURN;
!
	    ENDIF;
!
	ELSE
!
	    IF GET_INFO ( CURRENT_BUFFER, "DIRECTION" ) = FORWARD THEN
!
		SET ( REVERSE, CURRENT_BUFFER );
!
	    ELSE
!
		RETURN;
!
	    ENDIF;
!
	ENDIF;
!
	IF lst$x_primary THEN
!
	    lst$set_status_line ( lst$x_primary_filename );
!
	ELSE
!
	    lst$set_status_line ( lst$x_secondary_filename );
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$spawn
!
	LOCAL	ck_exit,
		cmd_line,
		crlf;
!
	cmd_line := READ_LINE ( "DCL Command: " );
!
	IF ( LAST_KEY = CTRL_Z_KEY ) THEN
!
	    RETURN;
!
	ELSE
!
	    IF cmd_line = lst$x_null THEN
!
		cmd_line := READ_LINE ( "Do you wish to create a subprocess? " );
!
		CHANGE_CASE ( cmd_line, UPPER );
!
		IF INDEX( "YES", cmd_line ) = 1 THEN
!
		    UPDATE(CURRENT_WINDOW);
		    SET ( SCREEN_UPDATE, OFF );
		    SPAWN ( lst$x_null );
		    SET ( SCREEN_UPDATE, ON );
		    SET ( PROMPT_AREA, lst$x_screen_length, 1, REVERSE );
		    cmd_line := READ_LINE ( "			 Hit any key to resume LIST ", 1 );
		    SET ( PROMPT_AREA, ( lst$x_screen_length - 2 ), 1, REVERSE );
		    REFRESH;
!
		ELSE
!
		    RETURN;
!
		ENDIF;
!
	    ELSE
!
		CHANGE_CASE ( cmd_line, UPPER );
		ck_exit := INDEX ( "EXIT", cmd_line );
!
		IF ( ck_exit <> 1 ) THEN
!
		    UPDATE(CURRENT_WINDOW);
		    SET ( SCREEN_UPDATE, OFF );
		    SPAWN ( cmd_line );
		    SET ( SCREEN_UPDATE, ON );
		    SET ( PROMPT_AREA, lst$x_screen_length, 1, REVERSE );
		    cmd_line := READ_LINE ( "			 Hit any key to resume LIST ", 1 );
		    SET ( PROMPT_AREA, ( lst$x_screen_length - 2 ), 1, REVERSE );
		    REFRESH;
!
		ELSE
!
		    lst$exit;
!
		ENDIF;
!
	    ENDIF;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$split_screen
!
	IF lst$x_screen_split = TRUE THEN
!
	    IF lst$x_primary THEN
!
		POSITION ( lst$secondary_window );
!
	    ELSE
!
		POSITION ( lst$primary_window );
!
	    ENDIF;
!
	    lst$x_primary := ( NOT lst$x_primary );
!
	ELSE
!
	    lst$x_screen_split := TRUE;
!
	    ADJUST_WINDOW ( lst$primary_window, 0, -10 );
!
!	    Create the secondary buffer and window
!
	    lst$secondary_buffer := CREATE_BUFFER ( "SECONDARY" );
	    lst$secondary_window := CREATE_WINDOW ( 12,
					(lst$x_screen_length - 14 ), ON );
!
	    SET ( NO_WRITE, lst$secondary_buffer, ON );
	    SET ( EOB_TEXT, lst$secondary_buffer, "[End of file]" );
	    SET ( SYSTEM, lst$secondary_buffer );
	    SET ( SCROLLING, lst$secondary_window, ON, 10, 10, 0 );
	    MAP ( lst$secondary_window, lst$secondary_buffer );
!
	    lst$x_primary := FALSE;
	    lst$x_section_distance := 8;
!
	    lst$s_input_file := READ_LINE ( 'File(s): ' );
!
	    IF ( lst$s_input_file = lst$x_null ) OR ( LAST_KEY = CTRL_Z_KEY ) THEN
!
		lst$unsplit_screen;
!
	    ELSE
!
		lst$get_file;
!
	    ENDIF;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$unsplit_screen
!
	IF ( NOT lst$x_screen_split ) THEN
!
	    MESSAGE ( "Screen is not currently split" );
	    RETURN;
!
	ENDIF;
!
	lst$x_screen_split := FALSE;
	lst$x_primary := TRUE;
	lst$x_section_distance := lst$x_screen_length - 6;
!
	UNMAP ( lst$secondary_window );
	DELETE ( lst$secondary_buffer );
	DELETE ( lst$secondary_window );
	ADJUST_WINDOW ( lst$primary_window, 0, 10 );
	POSITION ( lst$primary_window );
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$reset
!
	IF lst$x_primary THEN
!
	    lst$x_beginning_of_select := 0;
!
	ELSE
!
	    lst$xs_beginning_of_select := 0;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$new_file
!
	LOCAL	filename;
!
	filename := READ_LINE ( "File(s): " );
!
	IF ( filename = lst$x_null ) OR ( LAST_KEY = CTRL_Z_KEY ) THEN
!
	    RETURN;
!
	ENDIF;
!
	IF lst$x_primary THEN
!
	    lst$x_exit_flag := FALSE;
	    lst$x_initialize := TRUE;
	    lst$input_file := filename;
	    lst$get_file;
	    lst$x_initialize := FALSE;
	    lst$x_exit_flag := TRUE;
!
	ELSE
!
	    lst$s_input_file := filename;
	    lst$get_other_file;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$set_narrow
!
	SET ( WIDTH, MESSAGE_WINDOW, 80 );
	SET ( MARGINS, MESSAGE_BUFFER, 1, 80 );
	SET ( WIDTH, lst$primary_window, 80 );
	SET ( MARGINS, lst$primary_buffer, 1, 80 );
!
	IF lst$x_screen_split THEN
!
	    SET ( WIDTH, lst$secondary_window, 80 );
	    SET ( MARGINS, lst$secondary_buffer, 1, 80 );
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$exit
!
    IF lst$x_primary THEN

	IF NOT lst$x_cut_empty THEN
!
	    MESSAGE ( "CUT buffer is not empty" );
	    lst$write_file;
!
	ENDIF;
!
	EXIT;

    ELSE

	lst$unsplit_screen

    ENDIF;
!
ENDPROCEDURE
!

!
PROCEDURE lst$set_wide
!
	SET ( WIDTH, MESSAGE_WINDOW, 132 );
	SET ( MARGINS, MESSAGE_BUFFER, 1, 132 );
	SET ( WIDTH, lst$primary_window, 132 );
	SET ( MARGINS, lst$primary_buffer, 1, 132 );
!
	IF lst$x_screen_split THEN
!
	    SET ( WIDTH, lst$secondary_window, 132 );
	    SET ( MARGINS, lst$secondary_buffer, 1, 132 );
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$del_file
!
    LOCAL	delete_file,
		delete_buffer,
		delete_marker,
		delete_process,
		curbuf,
		answer;
!
	IF lst$x_primary THEN
!
	    delete_file := lst$x_primary_filename;
!
	ELSE
!
	    delete_file := lst$x_secondary_filename;
!
	ENDIF;
!
	answer := READ_LINE ( "Really delete " + delete_file + "? " );
!
	CHANGE_CASE ( answer, UPPER );
!
	IF INDEX ( "YES", answer ) = 1 THEN
!
	    curbuf := CURRENT_BUFFER;
!
	    SET ( SUCCESS, OFF );
	    SET ( INFORMATIONAL, OFF );
	    delete_buffer  := CREATE_BUFFER ( "DELETE" );
	    delete_process := CREATE_PROCESS ( delete_buffer, "DELETE/LOG " +
					       delete_file );
	    POSITION ( BEGINNING_OF ( delete_buffer ) );
	    delete_marker := SELECT ( NONE );
	    POSITION ( END_OF ( delete_buffer ) );
	    MESSAGE ( SELECT_RANGE );
	    POSITION ( curbuf );
!
	    delete_marker := 0;
	    DELETE ( delete_process );
	    DELETE ( delete_buffer );
	    SET ( SUCCESS, ON );
	    SET ( INFORMATIONAL, ON );
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$cut
!
    LOCAL	curbuf,
		copy_range;
!
	IF lst$x_primary THEN
!
	    IF lst$x_beginning_of_select <> 0 THEN
!
		copy_range := SELECT_RANGE;
		lst$x_beginning_of_select := 0;
!
		POSITION ( END_OF ( lst$cut_buffer ) );
		COPY_TEXT ( copy_range );
		POSITION ( lst$primary_window );
		lst$x_cut_empty := FALSE;
		RETURN;
!
	    ENDIF;
!
	ELSE
!
	    IF lst$xs_beginning_of_select <> 0 THEN
!
		copy_range := SELECT_RANGE;
		lst$xs_beginning_of_select := 0;
!
		POSITION ( END_OF ( lst$cut_buffer ) );
		COPY_TEXT ( copy_range );
		POSITION ( lst$secondary_window );
		lst$x_cut_empty := FALSE;
		RETURN;
!
	    ENDIF;
!
	ENDIF;

!
	lst$ask := READ_LINE ( "No select range active. " +
			       "CUT entire buffer? " );
!
	CHANGE_CASE ( lst$ask, UPPER );
!
	IF ( INDEX ( "YES", lst$ask ) <> 0 ) THEN
!
	    curbuf := CURRENT_BUFFER;
	    POSITION ( END_OF ( lst$cut_buffer ) );
	    COPY_TEXT ( curbuf );
	    POSITION ( curbuf );
	    lst$x_cut_empty := FALSE;
!
	ENDIF;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE lst$define_keys
!
!	Define the arrow keys
!
	DEFINE_KEY (	"SHIFT ( CURRENT_WINDOW, -8 )",
			RIGHT, "RIGHT_ARROW" );
	DEFINE_KEY (	"SHIFT ( CURRENT_WINDOW,  8 )",
			LEFT,  "LEFT_ARROW" );
	DEFINE_KEY (	"lst$direction ( 1 );", KP4, "ADVANCE" );
	DEFINE_KEY (	"lst$direction ( 0 );", KP5, "BACKUP" );
!
	DEFINE_KEY (	"lst$select;", PERIOD, "SELECT" );
	DEFINE_KEY (	"lst$write_file;", KP3, "WRITESEL" );
	DEFINE_KEY (	"lst$next_line ( CURRENT_DIRECTION );", KP0,
			"NEXTLINE" );
	DEFINE_KEY (	"lst$cut;", KP6, "CUT" );
	DEFINE_KEY (	"lst$page;", KP7, "PAGE" );
	DEFINE_KEY (	"lst$section ( CURRENT_DIRECTION );", KP8, "SECTION" );
	DEFINE_KEY (	"SET ( TEXT, CURRENT_WINDOW, GRAPHIC_TABS );", KP9,
			"SEETAB");
	DEFINE_KEY (	"lst$down_arrow", DOWN, "DOWN_ARROW" );
	DEFINE_KEY (	"lst$up_arrow", UP, "UP_ARROW" );
	DEFINE_KEY (	"lst$search", E1, "FIND" );
	DEFINE_KEY (	"lst$select", E4, "SELECT" );
	DEFINE_KEY (	"lst$section ( REVERSE )", E5, "SECTION" );
	DEFINE_KEY (	"lst$section ( FORWARD )", E6, "SECTION" );
	DEFINE_KEY (	"lst$help;", HELP, "HELP" );
	DEFINE_KEY (	"lst$spawn;", DO, "SPAWN" );
	DEFINE_KEY (	"lst$help;", PF2, "HELP" );
	DEFINE_KEY (	"lst$search_next", PF3, "FNDNXT" );
	DEFINE_KEY (	"lst$get_file", PF4, "NEXTFILE" );
	DEFINE_KEY (	"lst$print_file", MINUS, "PRNTFILE" );
	DEFINE_KEY (	"lst$set_narrow;", COMMA, "NARROW" );
!
	DEFINE_KEY (	"lst$split_screen", ENTER, "SPLTSCRN" );
	DEFINE_KEY (	"lst$down_arrow", CTRL_M_KEY, "DOWN_ARROW" );
	DEFINE_KEY (	"REFRESH;", CTRL_W_KEY, "REFRESH" );
	DEFINE_KEY (	"lst$exit", CTRL_Z_KEY, "EXIT" );
	DEFINE_KEY (	"lst$exit", F10, "EXIT_KEY" );
!
!	GOLD function keys
!
	DEFINE_KEY (	"lst$search", KEY_NAME ( PF3, SHIFT_KEY ), "FIND" );
	DEFINE_KEY (	"lst$new_file", KEY_NAME ( PF4, SHIFT_KEY ), "NEWFILE" );
	DEFINE_KEY (	"lst$del_file;", KEY_NAME ( MINUS, SHIFT_KEY ), "DELFILE" );
	DEFINE_KEY (	"lst$set_wide;", KEY_NAME ( COMMA, SHIFT_KEY ), "WIDE" );
	DEFINE_KEY (	"lst$unsplit_screen",
			KEY_NAME ( ENTER, SHIFT_KEY ), "UNSPLIT" );
	DEFINE_KEY (	"lst$reset;",
			KEY_NAME ( PERIOD, SHIFT_KEY ), "RESET" );
	DEFINE_KEY (	"SCROLL ( MESSAGE_WINDOW, -1 );",
			KEY_NAME ( UP, SHIFT_KEY ), "UPMSSG" );
	DEFINE_KEY (	"SCROLL ( MESSAGE_WINDOW, 1 );",
			KEY_NAME ( DOWN, SHIFT_KEY ), "DWNMSSG" );
	DEFINE_KEY (	"SHIFT ( MESSAGE_WINDOW, -8 )",
			KEY_NAME ( RIGHT, SHIFT_KEY ), "RGHTMSSG" );
	DEFINE_KEY (	"SHIFT ( MESSAGE_WINDOW,  8 )",
			KEY_NAME ( LEFT, SHIFT_KEY ), "LFTMSSG" );
	DEFINE_KEY (	"lst$show_cut;",
			KEY_NAME ( KP0, SHIFT_KEY ), "SHOWCUT" );
	DEFINE_KEY (	"POSITION ( END_OF ( CURRENT_BUFFER ) );",
			KEY_NAME ( KP4, SHIFT_KEY ), "BOTTOM" );
	DEFINE_KEY (	"POSITION ( BEGINNING_OF ( CURRENT_BUFFER ) );",
			KEY_NAME ( KP5, SHIFT_KEY ), "TOP" );
	DEFINE_KEY (	"lst$erase_cut_buffer", KEY_NAME ( KP6, SHIFT_KEY ),
			"CLEARCUT");
	DEFINE_KEY (	"SET ( TEXT, CURRENT_WINDOW, NO_TRANSLATE );",
			KEY_NAME ( KP8, SHIFT_KEY ), "SEEALL");
	DEFINE_KEY (	"SET ( TEXT, CURRENT_WINDOW, BLANK_TABS );",
			KEY_NAME ( KP9, SHIFT_KEY ), "NOSEEALL");
	DEFINE_KEY (	"lst$spawn;", KEY_NAME ( KP7, SHIFT_KEY ), "SPAWN" );
!
	DEFINE_KEY (	"lst$bad_key( 'DEL_KEY' )", DEL_KEY, "DELETE" );
	DEFINE_KEY (	"lst$bad_key( 'A' )", KEY_NAME( "A" ), "A" );
	DEFINE_KEY (	"lst$bad_key( 'B' )", KEY_NAME( "B" ), "B" );
	DEFINE_KEY (	"lst$bad_key( 'C' )", KEY_NAME( "C" ), "C" );
	DEFINE_KEY (	"lst$bad_key( 'D' )", KEY_NAME( "D" ), "D" );
	DEFINE_KEY (	"lst$bad_key( 'E' )", KEY_NAME( "E" ), "E" );
	DEFINE_KEY (	"lst$bad_key( 'F' )", KEY_NAME( "F" ), "F" );
	DEFINE_KEY (	"lst$bad_key( 'G' )", KEY_NAME( "G" ), "G" );
	DEFINE_KEY (	"lst$bad_key( 'H' )", KEY_NAME( "H" ), "H" );
	DEFINE_KEY (	"lst$bad_key( 'I' )", KEY_NAME( "I" ), "I" );
	DEFINE_KEY (	"lst$bad_key( 'J' )", KEY_NAME( "J" ), "J" );
	DEFINE_KEY (	"lst$bad_key( 'K' )", KEY_NAME( "K" ), "K" );
	DEFINE_KEY (	"lst$bad_key( 'L' )", KEY_NAME( "L" ), "L" );
	DEFINE_KEY (	"lst$bad_key( 'M' )", KEY_NAME( "M" ), "M" );
	DEFINE_KEY (	"lst$bad_key( 'N' )", KEY_NAME( "N" ), "N" );
	DEFINE_KEY (	"lst$bad_key( 'O' )", KEY_NAME( "O" ), "O" );
	DEFINE_KEY (	"lst$bad_key( 'P' )", KEY_NAME( "P" ), "P" );
	DEFINE_KEY (	"lst$bad_key( 'Q' )", KEY_NAME( "Q" ), "Q" );
	DEFINE_KEY (	"lst$bad_key( 'R' )", KEY_NAME( "R" ), "R" );
	DEFINE_KEY (	"lst$bad_key( 'S' )", KEY_NAME( "S" ), "S" );
	DEFINE_KEY (	"lst$bad_key( 'T' )", KEY_NAME( "T" ), "T" );
	DEFINE_KEY (	"lst$bad_key( 'U' )", KEY_NAME( "U" ), "U" );
	DEFINE_KEY (	"lst$bad_key( 'V' )", KEY_NAME( "V" ), "V" );
	DEFINE_KEY (	"lst$bad_key( 'W' )", KEY_NAME( "W" ), "W" );
	DEFINE_KEY (	"lst$bad_key( 'X' )", KEY_NAME( "X" ), "X" );
	DEFINE_KEY (	"lst$bad_key( 'Y' )", KEY_NAME( "Y" ), "Y" );
	DEFINE_KEY (	"lst$bad_key( 'Z' )", KEY_NAME( "Z" ), "Z" );
	DEFINE_KEY (	"lst$bad_key( 'a' )", KEY_NAME( "a" ), "a" );
	DEFINE_KEY (	"lst$bad_key( 'b' )", KEY_NAME( "b" ), "b" );
	DEFINE_KEY (	"lst$bad_key( 'c' )", KEY_NAME( "c" ), "c" );
	DEFINE_KEY (	"lst$bad_key( 'd' )", KEY_NAME( "d" ), "d" );
	DEFINE_KEY (	"lst$bad_key( 'e' )", KEY_NAME( "e" ), "e" );
	DEFINE_KEY (	"lst$bad_key( 'f' )", KEY_NAME( "f" ), "f" );
	DEFINE_KEY (	"lst$bad_key( 'g' )", KEY_NAME( "g" ), "g" );
	DEFINE_KEY (	"lst$bad_key( 'h' )", KEY_NAME( "h" ), "h" );
	DEFINE_KEY (	"lst$bad_key( 'i' )", KEY_NAME( "i" ), "i" );
	DEFINE_KEY (	"lst$bad_key( 'j' )", KEY_NAME( "j" ), "j" );
	DEFINE_KEY (	"lst$bad_key( 'k' )", KEY_NAME( "k" ), "k" );
	DEFINE_KEY (	"lst$bad_key( 'l' )", KEY_NAME( "l" ), "l" );
	DEFINE_KEY (	"lst$bad_key( 'm' )", KEY_NAME( "m" ), "m" );
	DEFINE_KEY (	"lst$bad_key( 'n' )", KEY_NAME( "n" ), "n" );
	DEFINE_KEY (	"lst$bad_key( 'o' )", KEY_NAME( "o" ), "o" );
	DEFINE_KEY (	"lst$bad_key( 'p' )", KEY_NAME( "p" ), "p" );
	DEFINE_KEY (	"lst$bad_key( 'q' )", KEY_NAME( "q" ), "q" );
	DEFINE_KEY (	"lst$bad_key( 'r' )", KEY_NAME( "r" ), "r" );
	DEFINE_KEY (	"lst$bad_key( 's' )", KEY_NAME( "s" ), "s" );
	DEFINE_KEY (	"lst$bad_key( 't' )", KEY_NAME( "t" ), "t" );
	DEFINE_KEY (	"lst$bad_key( 'u' )", KEY_NAME( "u" ), "u" );
	DEFINE_KEY (	"lst$bad_key( 'v' )", KEY_NAME( "v" ), "v" );
	DEFINE_KEY (	"lst$bad_key( 'w' )", KEY_NAME( "w" ), "w" );
	DEFINE_KEY (	"lst$bad_key( 'x' )", KEY_NAME( "x" ), "x" );
	DEFINE_KEY (	"lst$bad_key( 'y' )", KEY_NAME( "y" ), "y" );
	DEFINE_KEY (	"lst$bad_key( 'z' )", KEY_NAME( "z" ), "z" );
	DEFINE_KEY (	"lst$bad_key( '1' )", KEY_NAME( "1" ), "1" );
	DEFINE_KEY (	"lst$bad_key( '2' )", KEY_NAME( "2" ), "2" );
	DEFINE_KEY (	"lst$bad_key( '3' )", KEY_NAME( "3" ), "3" );
	DEFINE_KEY (	"lst$bad_key( '4' )", KEY_NAME( "4" ), "4" );
	DEFINE_KEY (	"lst$bad_key( '5' )", KEY_NAME( "5" ), "5" );
	DEFINE_KEY (	"lst$bad_key( '6' )", KEY_NAME( "6" ), "6" );
	DEFINE_KEY (	"lst$bad_key( '7' )", KEY_NAME( "7" ), "7" );
	DEFINE_KEY (	"lst$bad_key( '8' )", KEY_NAME( "8" ), "8" );
	DEFINE_KEY (	"lst$bad_key( '9' )", KEY_NAME( "9" ), "9" );
	DEFINE_KEY (	"lst$bad_key( '0' )", KEY_NAME( "0" ), "0" );
	DEFINE_KEY (	"lst$bad_key( '!' )", KEY_NAME( "!" ), "!" );
	DEFINE_KEY (	"lst$bad_key( '@' )", KEY_NAME( "@" ), "@" );
	DEFINE_KEY (	"lst$bad_key( '#' )", KEY_NAME( "#" ), "#" );
	DEFINE_KEY (	"lst$bad_key( '$' )", KEY_NAME( "$" ), "$" );
	DEFINE_KEY (	"lst$bad_key( '%' )", KEY_NAME( "%" ), "%" );
	DEFINE_KEY (	"lst$bad_key( '^' )", KEY_NAME( "^" ), "^" );
	DEFINE_KEY (	"lst$bad_key( '&' )", KEY_NAME( "&" ), "&" );
	DEFINE_KEY (	"lst$bad_key( '*' )", KEY_NAME( "*" ), "*" );
	DEFINE_KEY (	"lst$bad_key( '(' )", KEY_NAME( "(" ), "(" );
	DEFINE_KEY (	"lst$bad_key( ')' )", KEY_NAME( ")" ), ")" );
	DEFINE_KEY (	"lst$bad_key( '_' )", KEY_NAME( "_" ), "_" );
	DEFINE_KEY (	"lst$bad_key( '-' )", KEY_NAME( "-" ), "-" );
	DEFINE_KEY (	"lst$bad_key( '+' )", KEY_NAME( "+" ), "+" );
	DEFINE_KEY (	"lst$bad_key( '=' )", KEY_NAME( "=" ), "=" );
	DEFINE_KEY (	"lst$bad_key( '{' )", KEY_NAME( "{" ), "{" );
	DEFINE_KEY (	"lst$bad_key( '[' )", KEY_NAME( "[" ), "[" );
	DEFINE_KEY (	"lst$bad_key( '}' )", KEY_NAME( "}" ), "}" );
	DEFINE_KEY (	"lst$bad_key( ']' )", KEY_NAME( "]" ), "]" );
	DEFINE_KEY (	"lst$bad_key( ':' )", KEY_NAME( ":" ), ":" );
	DEFINE_KEY (	"lst$bad_key( ';' )", KEY_NAME( ";" ), ";" );
	DEFINE_KEY (	"lst$bad_key( '|' )", KEY_NAME( "|" ), "|" );
	DEFINE_KEY (	"lst$bad_key( '\' )", KEY_NAME( "\" ), "\" );
	DEFINE_KEY (	"lst$bad_key( ',' )", KEY_NAME( "," ), "," );
	DEFINE_KEY (	"lst$bad_key( '.' )", KEY_NAME( "." ), "." );
	DEFINE_KEY (	"lst$bad_key( '/' )", KEY_NAME( "/" ), "/" );
	DEFINE_KEY (	"lst$bad_key( '?' )", KEY_NAME( "?" ), "?" );
	DEFINE_KEY (	"lst$bad_key( '<' )", KEY_NAME( "<" ), "<" );
	DEFINE_KEY (	"lst$bad_key( '>' )", KEY_NAME( ">" ), ">" );
	DEFINE_KEY (	"lst$bad_key( '' )", KEY_NAME( '''' ), '''' );
	DEFINE_KEY (	"lst$bad_key( """" )", KEY_NAME( """" ), """" );
	DEFINE_KEY (	"lst$bad_key( '`' )", KEY_NAME( "`" ), "`" );
	DEFINE_KEY (	"lst$bad_key( '~' )", KEY_NAME( "~" ), "~" );
!
ENDPROCEDURE
!

!
PROCEDURE lst$local_init
!
	lst$local_init := TRUE;
	lst$x_initialize := FALSE;
	lst$x_section_distance := lst$x_screen_length - 6;
!
	RETURN;
!
ENDPROCEDURE
!

!
PROCEDURE TPU$INIT_PROCEDURE
!
	LOCAL	temp;
!
	ON_ERROR
!
	    IF ERROR = TPU$_NOJOURNAL THEN
!
		RETURN
!
	    ELSE
!
		lst$exit
!
	    ENDIF;
!
	ENDON_ERROR
!
!	Do some intializations
!
	lst$init_variables;
!
	lst$x_screen_length := GET_INFO ( SCREEN, "VISIBLE_LENGTH" );
!
	SET ( FACILITY_NAME, "LIST" );
	SET ( AUTO_REPEAT, ON );
	SET ( TIMER, ON, 'Working...' );
	SET ( BELL, ALL, ON );
	SET ( MESSAGE_FLAGS, 1 );
!
! Create all the nessasary buffers and windows
!
!	1.	We need a HELP buffer to show the keypad diagram.
!	2.	We need a MESSAGES buffer to show broadcast messages and errors.
!	3.	We need a CUT buffer to store stuff prior to a FILE WRITE.
!	4.	We need a PRIMARY buffer for the main file to be listed.
!	5.	We need a SECONDARY buffer for split-screen listings.
!
!	HELP Buffer
!
	lst$help_buffer := CREATE_BUFFER( "HELP" );
	lst$help_window := CREATE_WINDOW ( 1, 24, OFF );
	SET ( EOB_TEXT, lst$help_buffer, lst$x_null );
	SET ( NO_WRITE, lst$help_buffer, ON );
	SET ( PERMANENT, lst$help_buffer );
	SET ( SYSTEM, lst$help_buffer );
	SET ( TEXT, lst$help_window, NO_TRANSLATE );
!
!	PROMPT area
!
	SET ( PROMPT_AREA, ( lst$x_screen_length - 2 ), 1, REVERSE );
!
!	MESSAGE buffer
!
	MESSAGE_BUFFER := CREATE_BUFFER ( "MESSAGE" );
	SET ( EOB_TEXT, MESSAGE_BUFFER, lst$x_null );
	SET ( PERMANENT, MESSAGE_BUFFER );
	SET ( NO_WRITE, MESSAGE_BUFFER, ON );
	SET ( SYSTEM, MESSAGE_BUFFER );
	SET ( MAX_LINES, MESSAGE_BUFFER, 20 );
	MESSAGE_WINDOW := CREATE_WINDOW ( ( lst$x_screen_length - 1 ), 2, OFF );
	SET ( VIDEO, MESSAGE_WINDOW, NONE );
	MAP ( MESSAGE_WINDOW, MESSAGE_BUFFER );
!
!	Create buffer for the CUT command.
!
	lst$cut_buffer := CREATE_BUFFER ( "CUT" );
	SET ( NO_WRITE, lst$cut_buffer, ON );
!
	POSITION ( lst$help_buffer );
!
!	Create the PRIMARY buffer
!
	lst$primary_buffer := CREATE_BUFFER ( "PRIMARY" );
	lst$primary_window := CREATE_WINDOW ( 1,
					(lst$x_screen_length - 3), ON );
!
	SET ( NO_WRITE, lst$primary_buffer, ON );
	SET ( EOB_TEXT, lst$primary_buffer, "[End of file]" );
	SET ( SYSTEM, lst$primary_buffer );
	SET ( SCROLLING, lst$primary_window, ON, 10, 10, 0 );
!
	MAP ( lst$primary_window, lst$primary_buffer );
!
!	Get filename from the command line
!
	lst$input_file := GET_INFO ( COMMAND_LINE, "FILE_NAME" );
!
	IF lst$input_file = lst$x_null THEN
!
	    lst$input_file := READ_LINE ( 'File(s): ' );
!
	    IF	( lst$input_file = lst$x_null )	OR
		( LAST_KEY = CTRL_Z_KEY )	THEN
!
		lst$exit
!
	    ENDIF;
!
	ENDIF;

	temp := FILE_SEARCH ( lst$x_null );
!
!	Load file into the primary buffer
!
	lst$get_file;
!
	lst$local_init;
!
ENDPROCEDURE
!
!
lst$define_keys;		! Bind keys
!
COMPILE ( 'PROCEDURE lst$define_keys ENDPROCEDURE');
SAVE ( 'lstsecini.gbl' );
QUIT