! EVE$SHOW.TPU 			31-DEC-1992 11:59			Page 1

module eve$show ident "V03-015"

!
!	       COPYRIGHT © 1986,1992 BY
!	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
!		    ALL RIGHTS RESERVED
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY:
!	DECTPU - Text Processing Utility
!	EVE - Extensible Versatile Editor
!
! ABSTRACT:
!	This is the source program for the EVE interface advanced move
!	and delete features. This file was obtained from the old
!	evesecini.tpu file.
!
! ENVIRONMENT:
!	OpenVMS VAX, OpenVMS AXP, RISC/ULTRIX
!
!Author: Bill Robinson (among others)
!
! CREATION DATE: 10-Oct-1986
!
! MODIFIED BY:
!
!--

! EVE$SHOW.TPU 								Page 2

!++
!				Table of Contents 
!
!				  EVE$SHOW.TPU
!				31-DEC-1992 12:00
!
!	Procedure name			Page	Description
!	--------------			----	------------
!
!	eve_show_buffers 		   3	List all non-system buffers
!	eve_show_system_buffers 	   3	List all system buffers
!	eve_delete_buffer 		   4	Delete a buffer by name
!	eve$bufed_show 			   5	Build the buffer list
!	eve$$bufed_format_line 		   6	Format SHOW BUFFERS line
!	eve$$bufed_remove 		   7	Delete the buffer pointed to
!	eve$delete_buffer 		   8	Delete a buffer
!	eve$$bufed_select 		   9	Goto the buffer pointed to
!	eve$$bufed_get_entry 		  10	Scan a buffer line
!	eve_show_summary 		  11	List TPU and EVE version etc.
!	eve_show 			  12	Show each non-system buffer
!	eve$$show_buffer_info 		  13	Show subprocedure
!	eve_show_defaults_buffer 	  14	Show default buffer top level
!	eve$$buffer_list_status 	  15	Make status line for buffer list
!--

! EVE$SHOW.TPU 								Page 3

procedure eve_show_buffers		! List all non-system buffers

if eve$bufed_show (FALSE)
then
    return (TRUE);
else
    eve$learn_abort;
    return (FALSE);
endif;

endprocedure	! eve_show_buffers	

procedure eve_show_system_buffers	! List all system buffers

if eve$bufed_show (TRUE)
then
    return (TRUE);
else
    eve$learn_abort;
    return (FALSE);
endif;

endprocedure	! eve_show_system_buffers

! EVE$SHOW.TPU 								Page 4

procedure eve_delete_buffer		! Delete a buffer by name
    (the_name)

local   the_buffer,
	buffer_name;

on_error
    [OTHERWISE]:
endon_error;

if not eve$declare_intention (eve$k_action_new_buffer)
then
    return (FALSE);
endif;

if not eve$prompt_string (the_name,
			  buffer_name,
			  message_text (EVE$_DELBUFPROMPT, 1),
			  message_text (EVE$_NOBUFDELED, 0))
then
    eve$learn_abort;
    return (FALSE);
endif;

the_buffer := get_info (BUFFERS, "find_buffer", buffer_name);
if the_buffer <> 0
then
    if eve$delete_buffer (the_buffer, FALSE)
    then
	return (TRUE);
    endif;
else
    eve$message (EVE$_NOSUCHBUF, 0, buffer_name);
endif;
eve$learn_abort;
return (FALSE);

endprocedure;	! eve_delete_buffer	

! EVE$SHOW.TPU 								Page 5

procedure eve$bufed_show	! Build the buffer list
    (show_system)	! Boolean - 1 causes system buffers to be listed

local   saved_mark,
	saved_window,
	saved_buffer,
	the_buffer,	      	! The buffer being listed
	state_flag,		! Flag for error handler
	temp;			! Used to build the record count as a string

on_error
    [TPU$_CONTROLC]:
	set (MODIFIABLE, eve$x_bufed_buffer, OFF);
	if state_flag		! unmap the BUFFER LIST buffer
	then
	    eve_buffer (get_info (get_info (saved_mark, "buffer"), "name"));
	endif;
	eve$$restore_position (saved_window, saved_mark);
	eve$learn_abort;
	abort;
    [TPU$_ENDOFBUF]:	! prevent EOB message if BUFFER LIST blank
    [OTHERWISE]:
endon_error;

if eve$check_bad_window
then
    eve$learn_abort;
    return (FALSE);
endif;

eve$$x_bufed_range := 0;

saved_mark := mark (FREE_CURSOR);
saved_buffer := get_info (saved_mark, "buffer");
saved_window := current_window;

if get_info (eve$x_bufed_buffer, "type") <> BUFFER
then
    if eve$x_buf_str_buffer_list = tpu$k_unspecified
    then
	eve$x_buf_str_buffer_list := "BUFFER LIST";
    endif;
    eve$x_bufed_buffer := get_info (BUFFERS, "find_buffer",
				    eve$x_buf_str_buffer_list);
    if eve$x_bufed_buffer = 0
    then
	eve$x_bufed_buffer := eve$init_buffer (eve$x_buf_str_buffer_list, "");
	! set the status line as unmodifiable by eve$set_status_line
	eve$set_fixed_status_line (eve$x_bufed_buffer,
				   compile ("return eve$$buffer_list_status"));
    endif;
endif;
position (eve$x_bufed_buffer);
set (MODIFIABLE, eve$x_bufed_buffer, ON);
erase (eve$x_bufed_buffer);

if show_system
then
    the_buffer := get_info (BUFFERS, "first");
    loop
	exitif the_buffer = 0;
	if get_info (the_buffer, "system") and
	    (substr (get_info (the_buffer, "name"), 1, 1) <> "$")
	then
	    eve$$bufed_format_line (the_buffer, saved_buffer = the_buffer);
	endif;
	the_buffer := get_info (BUFFERS, "next");
    endloop;

    split_line;

    the_buffer := get_info (BUFFERS, "first");
    loop
	exitif the_buffer = 0;
	if get_info (the_buffer, "system") and
	    (substr (get_info (the_buffer, "name"), 1, 1) = "$")
	then
	    eve$$bufed_format_line (the_buffer, saved_buffer = the_buffer);
	endif;

	the_buffer := get_info (BUFFERS, "next");
    endloop;
else
    the_buffer := get_info (BUFFERS, "first");
    loop
	exitif the_buffer = 0;
	if not get_info (the_buffer, "system")
	then
	    eve$$bufed_format_line (the_buffer, saved_buffer = the_buffer);
	endif;

	the_buffer := get_info (BUFFERS, "next");
    endloop;
endif;
position (beginning_of (current_buffer));

loop
    temp := search_quietly ("
", FORWARD, EXACT);
    exitif temp = 0;
    position (temp);
    erase (temp);
    split_line;
    eve$insert_text (message_text (EVE$_SHOWBUF_ENTRY3, 1,
				   eve$x_bufed_buffer_name_length));
endloop;

position (beginning_of (current_buffer));
eve$insert_text (message_text (EVE$_SHOWBUF_HEAD, 1));
split_line;
state_flag := TRUE;

map (current_window, eve$x_bufed_buffer);
eve$set_status_line (current_window);

if get_info (eve$$x_bufed_range, "type") = RANGE
then
    position (beginning_of (eve$$x_bufed_range));
else
    position (beginning_of (current_buffer));
    move_vertical (2);
    move_horizontal (2);
endif;

set (MODIFIABLE, eve$x_bufed_buffer, OFF);
return (TRUE);

endprocedure;	! eve$bufed_show

! EVE$SHOW.TPU 								Page 6

procedure eve$$bufed_format_line	! Format SHOW BUFFERS line
    (the_buffer;
     highlight_flag)	! Boolean, 1 = highlight this buffer's name

local   is_modified,		! "Modified" or ""
	is_no_write,		! "No-write" or ""
	is_system,		! "Sys." or ""
	is_permanent,		! "Perm." or ""
	is_modifiable,		! "Non-mod." or ""
	temp,			! Temporary
	here,			! Current position
	start_mark,		! For highlighting current buffer's entry
	the_name,		! Buffer's name
	the_size;		! Size (record_count) of the buffer

on_error
    [OTHERWISE]:
endon_error;

the_name := get_info (the_buffer, "name");
the_size := get_info (the_buffer, "record_count");
if get_info (the_buffer, "modified")
then
    is_modified := message_text (EVE$_MODIFIED, 1);
else
    is_modified := "";
endif;
if get_info (the_buffer, "no_write")
then
    is_no_write := message_text (EVE$_NO_WRITE, 1);
else
    is_no_write := "";
endif;
if get_info (the_buffer, "system")
then
    is_system := message_text (EVE$_SYSTEM, 1);
else
    is_system := "";
endif;
if get_info (the_buffer, "permanent")
then
    is_permanent := message_text (EVE$_PERMANENT, 1);
else
    is_permanent := "";
endif;
if get_info (the_buffer, "modifiable")
then
    is_modifiable := "";
else
    is_modifiable := message_text (EVE$_UNMODIFIABLE, 1);
endif;
! Note: the BUFFER LIST buffer is always unmodifiable, even though
!	the get_info just found it modifiable (in order to fill it with data)
if the_buffer = current_buffer
then
    is_modifiable := message_text (EVE$_UNMODIFIED, 1);
endif;

if length (the_name) <= eve$x_bufed_buffer_name_length
then
    temp := message_text (EVE$_SHOWBUF_ENTRY, 1,
			  eve$x_bufed_buffer_name_length,
			  the_name,
			  the_size,
			  is_modified,
			  is_no_write,
			  is_system,
			  is_permanent,
			  is_modifiable);
else
    temp := message_text (EVE$_SHOWBUF_ENTRY2, 1,
			  the_name,
			  the_size,
			  is_modified,
			  is_no_write,
			  is_system,
			  is_permanent,
			  is_modifiable);
endif;
edit (temp, TRIM_TRAILING, OFF);
split_line;
copy_text (temp);

! highlight this buffer if flag is set

if highlight_flag
then
    here := mark (NONE);
    position (LINE_BEGIN);
    move_horizontal (2);
    start_mark := mark (NONE);
    if length (the_name) <= eve$x_bufed_buffer_name_length
    then
	position (LINE_END);
    else
	! the following relies on fact that EVE$__SHOWBUF_ENTRY2 contains a CR
	position (search_quietly (ascii (13), FORWARD));
	if current_character <> ascii (13)
	then
	    position (LINE_END);
	endif;
    endif;
    move_horizontal (-1);
    eve$$x_bufed_range := create_range (start_mark, mark (NONE),
					eve$x_bufed_highlighting);
    position (here);
endif;

endprocedure;	! eve$$bufed_format_line


! EVE$SHOW.TPU 								Page 7

procedure eve$$bufed_remove		! Delete the buffer pointed to

!	This routine is called by the REMOVE command when the BUFFER
!	LIST buffer is the current_buffer.  It deletes the buffer listed
!	on the current line. It only works in the "BUFFER LIST" buffer.
!	Note that it can delete the BUFFER LIST buffer from the SHOW
!	SYSTEM BUFFERS command.

local   the_buffer,		! Pointer to the buffer
	the_name,		! Name of the buffer as a string
	the_code,		! Code associated with the key
	the_type;		! Type of the code bound to the key

on_error
    [TPU$_CONTROLC]:
	if get_info (eve$x_bufed_buffer, "type") = BUFFER
	then		! mey have just deleted the BUFFER LIST buffer
	    set (MODIFIABLE, eve$x_bufed_buffer, OFF);
	endif;
	eve$learn_abort;
	abort;
endon_error;

if eve$$bufed_get_entry (the_name, the_buffer)
then
    if eve$delete_buffer (the_buffer, TRUE)
    then
	return (TRUE);
    endif;
endif;
return (FALSE);

endprocedure	! eve$$bufed_remove	

! EVE$SHOW.TPU 								Page 8

procedure eve$delete_buffer	! Delete a buffer
    (the_buffer,	! Buffer to delete
     remove_flag;	! Set if should remove entry in BUFFER LIST buffer
     the_answer,	! Answer string: delete_only, write_first, or
			! quit [=EXIT key or its synonyms]
     the_file_name)	! Output file_name for the buffer

! This routine actually deletes a specific buffer.

local   answer,
	answer_length,
	problem,		! "modified", "system", ...
	buffer_name,
	saved_mark,		! Remember where are in case abort
	saved_window,		! Remember where in case need to abort
	same_buffer,		! Flag set if cursor is in buffer to be deleted
	mapped_elsewhere,	! Flag set if buffer mapped <> current window
	output_file_name,	! File to which to pre-write the deleted buffer
	status,			! Status from set (widget)
	delete_only,		! String of eve$_delete_only
	write_first,		! String of eve$_write_first
	new_buffer;		! Buffer to map in place of deleted one.

on_error
    [TPU$_CONTROLC]:
	eve$$restore_position (saved_window, saved_mark);
	eve$learn_abort;
	abort;
    [TPU$_INVBUFDELETE]:
	eve$message (error_text, error);
	eve$$restore_position (saved_window, saved_mark);
    [OTHERWISE]:
	eve$$restore_position (saved_window, saved_mark);
endon_error;

problem := "";
if get_info (the_buffer, "type") <> BUFFER
then
    eve$learn_abort;
    return (FALSE);
endif;

! handle permanent buffers first

if get_info (the_buffer, "permanent")
then
    eve$message (TPU$_INVBUFDELETE);
    eve$learn_abort;
    return (FALSE);
endif;

delete_only := message_text (EVE$_DELETE_ONLY, 1);
write_first := message_text (EVE$_WRITE_FIRST, 1);

! See if buffer can't be deleted without notifying user

saved_window := current_window;
saved_mark := mark (FREE_CURSOR);
buffer_name := get_info (the_buffer, "name");
if get_info (the_buffer, "modified") and
    (get_info (the_buffer, "record_count") <> 0)
then
    problem := message_text (EVE$_MODIFIED, 1);
endif;
if get_info (the_buffer, "system")
then
    if problem <> ""
    then
	problem := problem + " ";
    endif;
    problem := problem + message_text (EVE$_SYSTEM, 1);
endif;
edit (problem, LOWER, TRIM);
if the_answer <> tpu$k_unspecified
then
    answer := the_answer;
    edit (answer, TRIM, COMPRESS, LOWER);
else
    answer := delete_only;
endif;
answer_length := length (answer);

! any problems?
if (problem <> "") and (the_answer = tpu$k_unspecified)
then
    loop
	if (eve$$x_state_array {eve$$k_command_line_flag}
	    = eve$k_invoked_by_menu)
	    and (eve$$x_state_array {eve$$k_dialog_box})  ! user hasn't disabled dialogs
	then
%if eve$x_option_decwindows
%then
	    if get_info (eve$x_reallydelbuf_dialog, "type") <> WIDGET
	    then
		eve$x_reallydelbuf_dialog := eve$create_widget
					     ("REALLYDELBUF_DIALOG");
	    endif;
	    eve$manage_widget (eve$x_reallydelbuf_dialog);

	    ! supersede the programs bound to the "delete_only" and
	    ! "write_first" buttons in the reallydelbuf dialog box
	    ! (can call eve$delete_buffer cause no data expected from widget)

	    eve$$set_responder (eve$$k_reallydelbuf_delete,
			       "eve$unmanage_widget(eve$x_reallydelbuf_dialog);"
				+
				fao
				(
		       "eve$delete_buffer (eve$find_buffer ('!AS'), !UL, '!AS')"
				 ,
				 buffer_name, remove_flag,
				 delete_only));
	    eve$$set_responder (eve$$k_reallydelbuf_write,
			       "eve$unmanage_widget(eve$x_reallydelbuf_dialog);"
				+
				fao
				(
		       "eve$delete_buffer (eve$find_buffer ('!AS'), !UL, '!AS')"
				 ,
				 buffer_name, remove_flag,
				 write_first));
%endif
	    return (eve$k_async_prompting);
	else
	    answer := eve$prompt_line (message_text (EVE$_REALLYDELBUF, 1,
						     problem),
				       eve$$x_prompt_terminators, "");
	    if answer = 0
	    then
		return (FALSE);
	    endif;
	endif;

	edit (answer, TRIM, COMPRESS, LOWER);
	answer_length := length (answer);
	if eve$test_synonym ("exit",
			     eve$$lookup_comment (last_key,
						  eve$x_key_map_list)) or
	    (answer_length = 0) or
	    (answer = substr (eve$x_quit, 1, answer_length))
	then
	    eve$message (EVE$_NOBUFDELED);
	    eve$learn_abort;
	    return (FALSE);
	endif;
	exitif (answer = substr (delete_only,
				 1, answer_length));
	exitif (answer = substr (write_first,
				 1, answer_length));
	! keep looping until a valid response (D, W, Q=RETURN=^Z)
    endloop;
endif;

! If buffer to delete = current_buffer, or it's not but it's mapped elsewhere,
! then get a buffer to map in its place.

if (current_buffer = the_buffer)
then
    same_buffer := TRUE;
else
    if get_info (the_buffer, "map_count") > 0
    then
	mapped_elsewhere := 1;
    endif;
endif;

new_buffer := current_buffer;
if same_buffer or mapped_elsewhere
then
    new_buffer := get_info (BUFFERS, "first");
    loop
	exitif new_buffer = 0;
	exitif (not get_info (new_buffer, "system")) and
	    (new_buffer <> the_buffer);
	new_buffer := get_info (BUFFERS, "next");
    endloop;
    if new_buffer = 0
    then
	new_buffer := eve$x_buf_str_main;
	if not eve$x_ultrix_active
	then		! upcase buffer names only on VMS
	    change_case (new_buffer, UPPER);
	endif;
	if get_info (the_buffer, "name") <> new_buffer
	then
	    eve_buffer (new_buffer);
	    new_buffer := current_buffer;
	else
%if eve$x_option_decwindows
%then
	    eve$popup_message (message_text (EVE$_CANTDELBUF, 1,
					     eve$x_buf_str_main));
%else
	    eve$message (EVE$_CANTDELBUF, 0, eve$x_buf_str_main);
%endif
	    eve$learn_abort;
	    return (FALSE);
	endif;
    endif;
endif;

if (new_buffer <> the_buffer)
then
    if (answer = substr (write_first,
			 1, answer_length))
    then
	if the_file_name <> tpu$k_unspecified
	then
	    output_file_name := the_file_name;
	else
	    if (get_info (the_buffer, "output_file") = 0) and
		(get_info (the_buffer, "file_name") = "")
	    then
		if (eve$$x_state_array {eve$$k_command_line_flag} =
		    eve$k_invoked_by_menu) and
		    ! user hasn't disabled dialogs
		    (eve$$x_state_array {eve$$k_dialog_box})
		then
%if eve$x_option_decwindows
%then
		    if get_info (eve$x_writedelprompt_dialog, "type") <> WIDGET
		    then
			eve$x_writedelprompt_dialog :=
				eve$create_widget ("WRITEDELPROMPT_DIALOG");
		    endif;
		    status := set (WIDGET,
				   get_info (WIDGET, "widget_id",
					     eve$x_writedelprompt_dialog,
				    "WRITEDELPROMPT_DIALOG.WRITEDELPROMPT_LABEL"
					     ),
				   eve$x_resource_array {eve$k_nlabel},
				   message_text (EVE$_WRITEDELPROMPT, 1,
						 buffer_name));
		    eve$manage_widget (eve$x_writedelprompt_dialog);

		    ! supersede the program bound to the OK button
		    ! in the writedelprompt dialog box (must call a procedure
		    ! before eve$delete_buffer to first get data from widget)

		    eve$$set_responder (eve$$k_writedelprompt_ok,
					fao
					(
			     "eve$$widget_writedelprompt_ok ('!AS', !UL, '!AS')"
					 ,
					 buffer_name, remove_flag, answer));

		    ! restore reallydelbuf widgets to invalid_event program
		    eve$$set_responder (eve$$k_reallydelbuf_delete,
					"eve$invalid_event(" +
					str (eve$$k_reallydelbuf_delete) + ")");
		    eve$$set_responder (eve$$k_reallydelbuf_write,
					"eve$invalid_event(" +
					str (eve$$k_reallydelbuf_write) + ")");
%endif
		    return (eve$k_async_prompting);
		else
		    output_file_name := eve$prompt_line (message_text
							 (EVE$_WRITEDELPROMPT,
							  1, buffer_name),
						       eve$$x_prompt_terminators
							 , "");
		    if (output_file_name = 0) or (output_file_name = "")
		    then
			eve$message (EVE$_NOBUFDELED);
			eve$$restore_position (saved_window, saved_mark);
			return (FALSE);
		    endif;
		endif;
	    else
		output_file_name := "";
	    endif;
	endif;
	if not eve$write_file (the_buffer, output_file_name, 0)
	then	! another message even if eve$write_file already did one
%if eve$x_option_decwindows
%then
	    eve$popup_message (message_text (EVE$_CANTWRITEDELBUF, 1,
					     buffer_name));
%else
	    eve$message (EVE$_CANTWRITEDELBUF, 0, buffer_name);
%endif
	    eve$$restore_position (saved_window, saved_mark);
	    return (FALSE);
	endif;
    endif;
    ! Remap all windows from buffer being deleted to new buffer
    eve$remap_windows (the_buffer, new_buffer);
    if (get_info (saved_mark, "buffer") = the_buffer) and
	(current_buffer <> new_buffer)
    then
	eve_buffer (get_info (new_buffer, "name"));
    endif;
    ! If buffer to delete is not current buffer but was mapped, put cursor in
    ! original position - not in new buffer mapped in place of the buffer.
    if mapped_elsewhere
    then
	eve$$restore_position (saved_window, saved_mark);
    endif;
    delete (the_buffer);
    if get_info (eve$x_select_position, "type") = UNSPECIFIED
    then				! the selection was in that buffer
	eve$x_select_position := 0;
	eve$stop_pending_delete;
    endif;
    eve$message (EVE$_BUFDELED, 0, buffer_name);
endif;

! restore writedelprompt_ok widget to invalid_event program

%if eve$x_option_decwindows
%then
eve$$set_responder (eve$$k_writedelprompt_ok,
		    "eve$invalid_event(" + str (eve$$k_writedelprompt_ok) +
		    ")");
%endif

if remove_flag <> tpu$k_unspecified
then
    if remove_flag
    then
	if get_info (eve$x_bufed_buffer, "type") <> BUFFER
	then		! The BUFFER LIST buffer was just deleted, exit
	    return (TRUE);	! or else we'll delete a line in user's buffer
	else
	    position (eve$x_bufed_buffer);
	endif;
	position (LINE_END);
	move_horizontal (-1);
	if current_character = "-"
	then
	    position (LINE_BEGIN);
	    set (MODIFIABLE, eve$x_bufed_buffer, ON);
	    erase_line;
	    set (MODIFIABLE, eve$x_bufed_buffer, OFF);
	else
	    position (LINE_BEGIN);
	endif;
	set (MODIFIABLE, eve$x_bufed_buffer, ON);
	erase_line;
	set (MODIFIABLE, eve$x_bufed_buffer, OFF);
	! sync remapped window with saved editing position
	map (saved_window, get_info (saved_mark, "buffer"));
	eve$set_status_line (saved_window);
    endif;
endif;

return (TRUE);

endprocedure;	! eve$delete_buffer

! EVE$SHOW.TPU 								Page 9

procedure eve$$bufed_select		! Goto the buffer pointed to

!	This routine is called by the EVE_SELECT procedure when the BUFFER
!	LIST buffer is the current_buffer.  It puts you in
!	the buffer listed on the current line.
!	It only works in the "BUFFER LIST" buffer.

local   the_buffer,		! Pointer to the buffer
	the_name;		! Name of the buffer as a string

if eve$$bufed_get_entry (the_name, the_buffer)
then
    return (eve_buffer (the_name));
endif;
return (FALSE);

endprocedure;	! eve$$bufed_select	

! EVE$SHOW.TPU 								Page 10

procedure eve$$bufed_get_entry		! Scan a buffer line
    (the_name,
     the_buffer)

!	This routine scans the line the cursor is on and if it is in the
!	proper format for a buffer listing, it returns both the name of
!	the buffer and a pointer to it.

local   the_start;		! A mark pointing to the buffer name.

on_error
    [OTHERWISE]:
endon_error;	! prevent search error messages

the_name := "";
the_buffer := 0;

if current_buffer <> eve$x_bufed_buffer
then
    eve$message (EVE$_NOTINBUFLIST);
else
    position (LINE_BEGIN);
    if search_quietly (ANCHOR + "  ", FORWARD) = 0
    then
	eve$message (EVE$_NOTSHOWBUFS);
    else
	! First see if we're on the continuation line for a long name
	move_horizontal (-2);
	if current_character = "-"
	then
	    position (LINE_BEGIN);
	else
	    move_horizontal (2);
	endif;
	move_horizontal (2);
	the_start := mark (NONE);
	move_horizontal (-2);
	move_vertical (1);
	move_horizontal (-2);
	if current_character = "-"
	then
	    move_horizontal (-2);
	else
	    move_horizontal ((eve$x_bufed_buffer_name_length + 2) -
			     current_offset);
	endif;
	the_name := create_range (the_start, mark (NONE), BOLD);
	the_name := substr (the_name, 1, length (the_name));
	edit (the_name, TRIM_TRAILING, OFF);
	the_buffer := get_info (BUFFERS, "find_buffer", the_name);
	if the_buffer = 0
	then
	    eve$message (EVE$_NOSUCHBUF, 0, the_name);
	endif;
	move_horizontal (2 - current_offset);
    endif;
endif;
return (the_buffer <> 0);

endprocedure;	! eve$$bufed_get_entry	

! EVE$SHOW.TPU 								Page 11

procedure eve_show_summary		! List TPU and EVE version etc.

local   temp,
	the_length,
	the_names,
	the_name,
	saved_mark,
	saved_window,
	space_index;

on_error
    [TPU$_CONTROLC]:
	if saved_window <> tpu$x_show_window
	then		! don't unmap it if that's what was mapped
	    unmap (tpu$x_show_window);
	endif;
	eve$$restore_position (saved_window, saved_mark);
	eve$learn_abort;
	abort;
    [OTHERWISE]:
	eve$$restore_position (saved_window, saved_mark);
endon_error;

eve$check_bad_window;

saved_mark := mark (FREE_CURSOR);
saved_window := current_window;

show (SUMMARY);

position (beginning_of (tpu$x_show_buffer));

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The following must by synchronized with the literal in TPU.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
temp := search_quietly ("Timer Message", FORWARD);
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if temp <> 0
then
    position (temp);
    position (LINE_BEGIN);
    erase_line;
    temp := current_line;
    edit (temp, TRIM, OFF);
    if temp = ""
    then
	erase_line;
    endif;
endif;

position (beginning_of (tpu$x_show_buffer));

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The following must by synchronized with the literal in TPU.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
temp := search_quietly ("calls to LIB$GET_VM,", FORWARD);
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if temp <> 0
then
    position (temp);
    position (LINE_BEGIN);
    erase_line;
endif;

position (end_of (tpu$x_show_buffer));

eve$insert_module_summary;

position (beginning_of (tpu$x_show_buffer));
eve$set_status_line (tpu$x_show_window);
return (TRUE);

endprocedure	! eve_show_summary	

! EVE$SHOW.TPU 								Page 12

procedure eve_show	! Show each non-system buffer

! Show information about all non-system buffers, one at a time.
! Ask if user wants more information after each buffer.

local   saved_mark,		! Marker for current cursor position
	saved_window,		! Current window
	saved_buffer,		! Current buffer
	buffer_to_show,		! Buffer passed to eve$$show_buffer_info
	window_to_show,		! Window passed to eve$$show_buffer_info
	next_buffer,		! Next candidate buffer
	show_key,		! String associated with key read after prompt
	throw_away;		! Result of eve$prompt_key - to resume editing

on_error
    [TPU$_CONTROLC]:
	eve$$restore_position (saved_window, saved_mark);
	eve$learn_abort;
	abort;
    [OTHERWISE]:
	eve$$restore_position (saved_window, saved_mark);
endon_error;

if get_info (eve$prompt_window, "buffer") <> 0
then
    eve$message (EVE$_CANTSHOW);
    update (message_window);
    eve$learn_abort;
    return (FALSE);
endif;

position (TEXT);		! prevent padding
saved_mark := mark (FREE_CURSOR);
saved_buffer := current_buffer;
saved_window := current_window;
buffer_to_show := saved_buffer;
window_to_show := saved_window;
next_buffer := get_info (BUFFERS, "last");
eve$map_help (tpu$x_show_buffer);
eve$set_status_line (tpu$x_show_window);

loop
    exitif next_buffer = 0;
    if (next_buffer <> saved_buffer) and
	(get_info (next_buffer, "system") = 0)
    then
	erase (tpu$x_show_buffer);
	position (tpu$x_show_buffer);
	eve$$show_buffer_info (buffer_to_show, window_to_show);
	if buffer_to_show = saved_buffer
	then
	    window_to_show := 0;
	endif;
	update (tpu$x_show_window);
	show_key := eve$$lookup_comment (eve$prompt_key (
							 message_text
							 (EVE$_DOFORMORE, 1)),
					 "");
	if eve$test_synonym ("do", show_key)
	then
	    buffer_to_show := next_buffer;
	else
	    eve$unmap_help;
	    if get_info (saved_window, "buffer") <> 0
	    then
		position (saved_window); ! in case package changed windows
	    endif;
	    return (TRUE);
	endif;
    endif;
    next_buffer := get_info (BUFFERS, "previous");
endloop;

erase (tpu$x_show_buffer);
eve$$show_buffer_info (buffer_to_show, window_to_show);
update (tpu$x_show_window);
throw_away := eve$prompt_key (message_text (EVE$_RESUMEPROMPT, 1));
eve$unmap_help;
if get_info (saved_window, "buffer") <> 0
then
    position (saved_window);	! in case package unmap_help changed windows
endif;
return (TRUE);

endprocedure;	! eve_show

! EVE$SHOW.TPU 								Page 13

procedure eve$$show_buffer_info ! Show subprocedure
    (this_buffer,	! Buffer being inquired about - input
     this_window)	! Window being inquired about - input

! Main routine called by show command.  Append information about the given
! buffer to the end of the show_buffer.  Mapping, erasing, etc. are
! handled in eve_show.

local   buffer_name,		! String used to hold the name of this_buffer
	input_file_name,	! String with input file name for this_buffer
	output_file_name,	! String with output file name for this_buffer
	journal_file_name,	! String with journal file name for this_buffer
	how_many_records,	! Number of records in this_buffer
	record_text,		! String for display of how_many_records
	the_index,		! Index into array of marks
	this_window_shift,	! Shift amount for this_window
	this_window_key_map,	! The key-map list for this window
	the_eob,		! Default buffer eob text
	the_action,		! Default buffer left/right margin action
	temp,			! A real temp variable
	default_flag,		! True if this_buffer = eve$default_buffer
	what_tab_stops;		! String or integer with tab stop settings

on_error
    [TPU$_NONAMES, TPU$_MULTIPLENAMES]:
    [OTHERWISE]:
endon_error;

default_flag := (this_buffer = eve$default_buffer);

position (end_of (tpu$x_show_buffer));
set (INSERT, tpu$x_show_buffer);	! should be insert anyway, but just in case...

copy_text (" " + eve$version);
split_line;

buffer_name := get_info (this_buffer, "name");
copy_text (message_text (EVE$_SHOW_HEADER, 1, buffer_name));
eve$$letter_wrap (index (current_line, buffer_name));
split_line;
split_line;

temp := message_text (EVE$_NOTMODIFIED, 1);

if not default_flag
then
    ! input file
    input_file_name := get_info (this_buffer, "file_name");
    if input_file_name = ""
    then
	input_file_name := message_text (EVE$_NONE);
    endif;
    copy_text (message_text (EVE$_SHOW_INPUTFILE, 1, input_file_name));
    eve$$letter_wrap (index (current_line, input_file_name));
    split_line;

    ! output file
    output_file_name := get_info (this_buffer, "output_file");
    if (output_file_name = 0) or (get_info (this_buffer, "no_write"))
    then
	output_file_name := message_text (EVE$_NONE, 1);
    endif;
    copy_text (message_text (EVE$_SHOW_OUTPUTFILE, 1, output_file_name));
    eve$$letter_wrap (index (current_line, output_file_name));
    split_line;

    ! buffer-change journal file
    if get_info (this_buffer, "journaling")
    then
	journal_file_name := get_info (this_buffer, "journal_file");
    else
	journal_file_name := message_text (EVE$_NONE);
    endif;
    copy_text (message_text (EVE$_SHOWJOURNALFILE, 1, journal_file_name));
    eve$$letter_wrap (index (current_line, journal_file_name));
    split_line;

    if get_info (this_buffer, "modified")
    then
	temp := message_text (EVE$_MODIFIED, 1);
    endif;
    copy_text (message_text (EVE$_SHOW_FIELD, 1, temp));
else
    copy_text (message_text (EVE$_SHOW_FIELD, 1, temp));
endif;

copy_text (message_text (EVE$_LEFTSETTO, 1,
			 get_info (this_buffer, "left_margin")));
split_line;

if get_info (this_buffer, "mode") = INSERT
then
    temp := eve$x_insert;
else
    temp := eve$x_overstrike;
endif;
copy_text (message_text (EVE$_SHOW_FIELD, 1,
			 message_text (EVE$_SHOW_MODE, 1, temp)));
copy_text (message_text (EVE$_RIGHTSETTO, 1,
			 get_info (this_buffer, "right_margin")));
split_line;

temp := eve$$x_paragraph_indent {this_buffer};
if temp = tpu$k_unspecified
then
    copy_text (message_text (EVE$_SHOW_FIELD, 1,
			     message_text (EVE$_SHOW_PARAINDENT, 1,
					   message_text (EVE$_NONE))));
else
    copy_text (message_text (EVE$_SHOW_FIELD, 1,
			     message_text (EVE$_SHOW_PARAINDENT, 1,
					   str (temp -
						get_info (this_buffer,
							  "left_margin")))));
endif;

temp := eve$$x_word_wrap_indent {this_buffer};
if temp = tpu$k_unspecified
then
    copy_text (message_text (EVE$_SHOW_WPSWRAP, 1,
			     message_text (EVE$_NONE, 1)));
else
    copy_text (message_text (EVE$_SHOW_WPSWRAP, 1, str (temp)));
endif;
split_line;

if get_info (this_buffer, "no_write")
then
    copy_text (message_text (EVE$_SHOW_FIELD, 1,
			     message_text (EVE$_READ_ONLY)));
else
    copy_text (message_text (EVE$_SHOW_FIELD, 1,
			     message_text (EVE$_WRITE)));
endif;
if get_info (this_buffer, "modifiable")
then
    copy_text (message_text (EVE$_MODIFIABLE));
else
    copy_text (message_text (EVE$_UNMODIFIABLE));
endif;
split_line;

if get_info (this_buffer, "direction") = FORWARD
then
    temp := eve$x_forward;
else
    temp := eve$x_reverse;
endif;
copy_text (message_text (EVE$_SHOW_FIELD, 1,
			 message_text (EVE$_SHOW_DIRECTION, 1, temp)));

if not default_flag
then
    if this_window <> 0
    then
	copy_text (message_text (EVE$_WIDSET, 1,
				 get_info (this_window, "width")));
    endif;
    split_line;

    how_many_records := get_info (this_buffer, "record_count");
    record_text := message_text (EVE$_SHOW_LINES, 1, how_many_records);
else
    split_line;
    how_many_records := get_info (this_buffer, "max_lines");
    if how_many_records = -1
    then
	record_text := message_text (EVE$_SHOW_NOMAXLINES, 1);
    else
	record_text := message_text (EVE$_SHOW_MAXLINES, 1, how_many_records);
    endif;
endif;
copy_text (message_text (EVE$_SHOW_FIELD, 1, record_text));

if not default_flag
then
    if this_window <> 0
    then
	this_window_shift := get_info (this_window, "shift_amount");
	if this_window_shift > 0
	then
	    copy_text (message_text (EVE$_SHIFTCOUNT, 1, this_window_shift));
	endif;
    endif;
endif;

split_line;

what_tab_stops := get_info (this_buffer, "tab_stops");
if get_info (what_tab_stops, "type") = INTEGER
then
    copy_text (message_text (EVE$_SHOW_TABEVERY, 1, what_tab_stops));
else
    copy_text (message_text (EVE$_SHOW_TABSETAT, 1, what_tab_stops));
    eve$$letter_wrap (index (current_line, what_tab_stops));
endif;
split_line;

position (this_buffer);
this_window_key_map := eve$current_key_map_list;
position (tpu$x_show_buffer);

if this_window_key_map <> eve$x_key_map_list
then
    if this_window_key_map <> ''
    then
	copy_text (message_text (EVE$_SHOW_KEYMAPLIST, 1, this_window_key_map));
    else
	copy_text (message_text (EVE$_SHOW_NOKEYMAP, 1));
    endif;
    split_line;
endif;

if default_flag
then
    the_eob := get_info (eve$default_buffer, "eob_text");
    if the_eob <> message_text (EVE$_EOBTEXT)
    then
	copy_text (message_text (EVE$_SHOW_EOBTEXT, 1, the_eob));
	split_line;
    endif;

    ! New EVE buffers are always MODIFIABLE and WRITEABLE, i.e., ignore
    ! these default buffer attributes.
endif;

the_action := get_info (this_buffer, "left_margin_action");
if the_action <> tpu$k_unspecified	! EVE has no default left_margin_action
then
    copy_text (message_text (EVE$_NONDEFLEFTACT, 1));
    split_line;
endif;

if get_info (eve$$x_right_action_program, "type") <> PROGRAM
then
    eve$$x_right_action_program := compile (eve$kt_word_wrap_routine);
endif;
the_action := get_info (this_buffer, "right_margin_action");
if the_action = tpu$k_unspecified
then
    temp := message_text (EVE$_SHOW_WRAP, 1, message_text (EVE$_OFF, 1));
else
    if the_action <> eve$$x_right_action_program
    then
	temp := message_text (EVE$_SHOW_WRAP, 1,
			      message_text (EVE$_NONDEFRIGHTACT, 1));
    else
	temp := message_text (EVE$_SHOW_WRAP, 1, message_text (EVE$_ON, 1));
    endif;
endif;
copy_text (temp);
split_line;

if not default_flag
then
    erase (eve$choice_buffer);
    position (beginning_of (eve$choice_buffer));
    split_line;
    move_vertical (-1);

    ! spin thru the mark array
    the_index := get_info (eve$$x_mark_array, "first");
    loop
	exitif the_index = tpu$k_unspecified;
	if get_info (eve$$x_mark_array {the_index}, "buffer") = this_buffer
	then
	    copy_text (the_index);
	    split_line;
	endif;
	the_index := get_info (eve$$x_mark_array, "next");
    endloop;
    append_line;	! get rid of blank line

    ! Display ambiguous mark names in the choice buffer

    if get_info (eve$choice_buffer, "record_count") = 0
    then
	position (end_of (tpu$x_show_buffer));
	copy_text (message_text (EVE$_SHOW_NOMARKS, 1));
    else
	eve$format_choices;
	position (end_of (tpu$x_show_buffer));
	copy_text (message_text (EVE$_SHOW_MARKS, 1));
	split_line;
	copy_text (eve$choice_buffer);
    endif;
endif;

if current_offset > 0
then
    split_line;
endif;

position (beginning_of (tpu$x_show_buffer));

endprocedure;	! eve$$show_buffer_info
         
! EVE$SHOW.TPU 								Page 14

procedure eve_show_defaults_buffer	! Show default buffer top level

! Show information about the $DEFAULT$ buffer.

local   saved_mark,		! Marker for current cursor position
	saved_window,		! Current window
	buffer_to_show,		! Buffer passed to eve$$show_buffer_info
	window_to_show,		! Window passed to eve$$show_buffer_info
	show_key;		! String associated with key read after prompt

if get_info (eve$prompt_window, "buffer") <> 0
then
    eve$message (EVE$_CANTSHOW);
    update (message_window);
    eve$learn_abort;
    return (FALSE);
endif;

position (TEXT);
saved_mark := mark (FREE_CURSOR);
saved_window := current_window;
buffer_to_show := eve$default_buffer;
window_to_show := saved_window;
eve$map_help (tpu$x_show_buffer);
eve$set_status_line (tpu$x_show_window);

erase (tpu$x_show_buffer);
eve$$show_buffer_info (eve$default_buffer, window_to_show);

update (tpu$x_show_window);
show_key := eve$$lookup_comment
	    (eve$prompt_key (message_text (EVE$_RESUMEPROMPT, 1)), "");

eve$unmap_help;
if get_info (saved_window, "buffer") <> 0
then
    position (saved_window); ! in case package changed windows
endif;
return (TRUE);

endprocedure;	! eve_show_defaults_buffer

! EVE$SHOW.TPU 								Page 15

procedure eve$$buffer_list_status	! Make status line for buffer list

local   left_side,		! The "Buffer: <name>" part
	right_side,		! The directions
	the_width;		! Unused width in the status line

left_side := eve$buffer_name_field (current_buffer);
right_side := "";
the_width := get_info (current_window, "width") - (length (left_side) + 1);

right_side := message_text (EVE$_SHOWBUFSTATUS, 1);
the_width := the_width - length (right_side);
if the_width < 0
then
    right_side := "";
endif;

if the_width < 0
then
    the_width := 0;
endif;

return (left_side + (" " * the_width) + right_side);

endprocedure;	! eve$$buffer_list_status

! EVE$SHOW.TPU 								Page 16


! Module initialization code

eve$x_bufed_buffer := 0;
eve$x_bufed_buffer_name_length := 24;
eve$x_bufed_highlighting := BOLD;	! Highlighting in BUFFER LIST

endmodule;

! EVE$SHOW.TPU 								Page 17

!
! EVE$BUILD time executable code
!

eve$$require ("eve$core");		! Build dependencies
eve$$require ("eve$file");
eve$$require ("eve$build");