!----------------------------+------------------------------------------+
!    Kurt Andersen           |       Jet Propulsion Laboratory          |
!      MIPL Applications     |       Mail Stop 168-427                  |
!      Software Engineer     |       4800 Oak Grove Drive               |
!    Office: 169-425         |       Pasadena, Calif.  91109            |
!----------------------------+-------------------------+----------------+
!  NETWORKS:                                           |                |
!              SPAN: Mipl3::KKA059    (5.153)          | Does the verb  |
!     ARPA Internet: KKA059@Mipl3.Jpl.Nasa.Gov         | `to flame'     |
!  Internet Address: [128.149.1.28]                    | come from the  |
!     ARPAnet->SPAN: KKA059%Mipl3@Star.Stanford.Edu    | days of the    |
!                or: KKA059%Mipl3.Span@Jpl-Vlsi.Arpa   | Inquisition?   |
! Ma Bell  (R.I.P.): (818) 354-1672                    |                |
!------------------------------------------------------+----------------+
!   The following TPU procedures may be freely used and distributed.
!   If any improvements are made, please communicate them back to me!



!  Global argument declaration for eve$parse
!
!     Add the following line to your personal
!       tpu$local_init procedure if you have
!       made one.
!
procedure tpu$local_init        ! To initialize my procedures

eve$arg1_kill_buffer := "string";

endprocedure;


! Kill buffer.
!    Procedure will identify the buffer to be killed and pass a
!    buffer typed variable to the procedure dispose_of_buffer.
!
! Known Bugs:
!    Due to the EVE method of allocating and ordering buffers, KILL
!    may not always pick up another text buffer that meet the requirements
!    for a buffer to delete.
! Work-around:
!    Set your buffer to the desired buffer (the one to keep) and
!    then KILL the other.
!
! Parameters:
!
!   buffer_parameter    String containing buffer name - input
!
procedure eve_kill (buffer_parameter)

local buffer_name,      ! Local copy of buffer_parameter
      loop_buffer,      ! Current buffer being checked in loop
      loop_buffer_name,     ! String containing name of loop_buffer
      found_a_buffer,       ! True if buffer found with same exact name
      possible_buffer_name, ! Most recent string entered in choice buffer
      possible_buffer,      ! Buffer whose name is possible_buffer_name
      how_many_buffers,     ! Number of buffers listed in choice buffer
      next_buffer;      ! Next buffer used when deleting current buffer

if eve$check_bad_window then
    message ("Cursor has been moved to a text window; try command again");
    return;
endif;

if not (eve$prompt_string (buffer_parameter, buffer_name,
               "Buffer name: ", "Buffer not switched")) then
    return;
endif;
eve$cleanse_string (buffer_name);

! See if we have a buffer by that name

loop_buffer := get_info (buffers, eve$kt_first);
change_case (buffer_name, upper);   ! buffer names are uppercase
erase (eve$choice_buffer);

loop
    exitif loop_buffer = 0;
    loop_buffer_name := get_info (loop_buffer, eve$kt_name);
    if buffer_name = loop_buffer_name then
    found_a_buffer := 1;
    how_many_buffers := 1;
    exitif 1;
    else
    if buffer_name = substr (loop_buffer_name, 1, length (buffer_name)) then
            eve$add_choice (loop_buffer_name);
        possible_buffer := loop_buffer;
        possible_buffer_name := loop_buffer_name;
        how_many_buffers := how_many_buffers + 1;
    endif;
    endif;
    loop_buffer := get_info (buffers, "next");
endloop;

change_case (buffer_name, lower);   ! for messages
if found_a_buffer then
    dispose_of_buffer (loop_buffer);
else
    if get_info (eve$choice_buffer, eve$kt_record_count) > 0 then
    if how_many_buffers = 1 then
        dispose_of_buffer (possible_buffer);
    else
        change_case (buffer_name, lower);
        eve$display_choices
         (fao ("Ambiguous buffer name: !AS", buffer_name));
    endif;
    else
    message (fao ("Buffer !AS not found.", buffer_name));
    endif;
endif;     

eve$set_status_line (current_window);

endprocedure;

!
! Dispose of buffer.
!    Procedure will identify any windows to which the buffer is 
!    currently mapped, massage these appropriately, delete the
!    buffer unless it is the last normal editing buffer, and
!    map the next editing buffer to the appropriate windows.
!
! Parameters:
!
!   target_buffer          Buffer variable identifying the buffer
!                                  to be deleted - input
!
procedure dispose_of_buffer (target_buffer)

local window_to_change,     ! Target window for remapping
      this_window,              ! Current cursor window, to be returned to
      mapped_to,        ! Number of windows to which buffer is mapped
      buffer_name,      ! Name of target buffer
      next_buffer,      ! Buffer to replace target in windows
      this_position;        ! Current position

on_error
    ! Lots of different errors possible from write_file, doesn't matter here
    set (success, on);
    message (fao ("Will not delete; could not write buffer !AS",
          buffer_name));
    return;
endon_error;

! Check for non-deletable target buffer

if (get_info (target_buffer, "permanent")) or 
   (get_info (target_buffer, "system"))       then
    buffer_name := get_info (target_buffer, eve$kt_name);
    message (fao ("Buffer !AS cannot be deleted", buffer_name));
    return;
endif;

eve$check_bad_window;
this_position := mark (none);                   
this_window := current_window;

mapped_to := get_info (target_buffer, "map_count");

if mapped_to > 1 then       ! If the target buffer is mapped to two
    eve_one_window;     ! windows, return to one window format.
    mapped_to := 1;
endif;

if mapped_to then
    ! Identify the buffer which will replace the one deleted:

    next_buffer := get_info (buffers, eve$kt_last);
 
    if next_buffer = 0 then 
    buffer_name := get_info (target_buffer, eve$kt_name);
    message ("Last buffer failed, getting first buffer") ;
    next_buffer := get_info (buffers, eve$kt_first);
    endif;

    if next_buffer = target_buffer then
    message ("Current buffer is last buffer") ;
    next_buffer := get_info (buffers, "previous");
    endif;

    if ((next_buffer = 0) or (next_buffer = target_buffer)) or 
       (get_info (next_buffer, "system")) then
    buffer_name := get_info (target_buffer, eve$kt_name);
    message (fao ("Cannot delete buffer !AS, no other buffers", buffer_name));
    return;
    endif;

! Change windows to which the buffer is mapped:

    if eve$x_number_of_windows = 1 then     ! One window only
    window_to_change := current_window;
    map (eve$main_window, next_buffer);
    else                    ! Two windows, change one
    if target_buffer = get_info (eve$top_window, "buffer") then
        window_to_change := eve$top_window;
    else
        window_to_change := eve$bottom_window;
    endif;
    if window_to_change = current_window then
        eve_other_window;
    endif;
    unmap (window_to_change);
    map (window_to_change, next_buffer);
    eve$set_status_line (window_to_change);
    endif;
endif;

! Check to write buffer before deleting:

message (eve$kt_null);
buffer_name := get_info (target_buffer, eve$kt_name);

if (get_info (target_buffer, "modified")) and
    (not (get_info (target_buffer, "no_write"))) then
    if eve$insist_y_n (fao ("Write buffer !AS? ", buffer_name)) then
    if eve$x_trimming then
        message ("Trimming buffer...");
        eve$trim_buffer (target_buffer);
        message ("Trimming completed");
    endif;
    write_file (target_buffer);
    endif;
    set (no_write, target_buffer);
endif;  

delete (target_buffer);

if window_to_change <> 0 then
    update (window_to_change);
endif;

if get_info (this_window, "visible") then
    position (this_window);
endif;

endprocedure;