[comp.os.vms] TPU Procedure to delete EVE buffers

kka059@MIPL3.JPL.NASA.GOV (10/09/87)

  If anyone is interested, the following TPU procedure will delete buffers
that you may have accumulated during an editing session.  

  If the buffer has been modified, the user will be prompted regarding 
writing the buffer before it is deleted.  If the buffer to be deleted 
is on display in a window, the next buffer in the TPU internal list will 
be put into the window after the buffer is deleted. If the buffer to be 
deleted is currently on display in both of the dual EVE windows, the "next 
buffer" will be placed in a single window display on the screen.  

  The procedure will not let you delete the last normal editing buffer.

  Cheers and enjoy,
    Kurt

+----------------------------+------------------------------------------+
|    Kurt Andersen           |       Jet Propulsion Laboratory          |
|      MIPL Applications     |       Mail Stop 168-427                  |
|      Programmer            |       4800 Oak Grove Drive               |
|    Office: 169-425         |       Pasadena, Calif.  91109            |
+----------------------------+--------------------+---------------------+ 
|  NETWORKS:                                     / "The time has come," |
|              SPAN: Mipl3::KKA059    (5.153)   / the walrus said, "To  |
|     ARPA Internet: KKA059@Mipl3.Jpl.Nasa.Gov / speak of many things:  |
|                      [128.149.1.28]         / of patterns and ranges  |
|                                            / and variables, of TPU    |
| Ma Bell  (R.I.P.): (818) 354-1672         / and things..."            |
|                                          / (Apologies to the author)  |
+-----------------------------------------+-----------------------------+

....................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by KKA059 (Kurt Andersen @ Mipl3.Jpl)
$!      on Thursday 8-OCT-1987 15:46:01.11
$!
$! It contains the following 1 file:
$! KILL_BUFFER.TPU
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o);
Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal
(-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b)
EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="KILL_BUFFER.TPU"
$ Check_Sum_is=2082190597
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X!  Global argument declaration for eve$parse
X!
X!     Add the following line to your personal
X!       tpu$local_init procedure if you have
X!       made one.
X!
Xprocedure tpu$local_init                ! To initialize my procedures
X
Xeve$arg1_kill_buffer := "string";
X
Xendprocedure;
X
X!
X! Kill buffer.
X!    Procedure will identify the buffer to be killed and pass a
X!    buffer typed variable to the procedure dispose_of_buffer.
X!
X! Parameters:
X!
X!       buffer_parameter        String containing buffer name - input
X!
Xprocedure eve_kill_buffer (buffer_parameter)
X
Xlocal buffer_name,              ! Local copy of buffer_parameter
X      loop_buffer,              ! Current buffer being checked in loop
X      loop_buffer_name,         ! String containing name of loop_buffer
X      found_a_buffer,           ! True if buffer found with same exact name
X      possible_buffer_name,     ! Most recent string entered in choice buffer
X      possible_buffer,          ! Buffer whose name is possible_buffer_name
X      how_many_buffers,         ! Number of buffers listed in choice buffer
X      next_buffer;              ! Next buffer used when deleting current buffer
X
Xif eve$check_bad_window then
X    message ("Cursor has been moved to a text window; try command again");
X    return;
Xendif;
X
Xif not (eve$prompt_string (buffer_parameter, buffer_name,
X                           "Buffer name: ", "Buffer not switched")) then
X    return;
Xendif;
Xeve$cleanse_string (buffer_name);
X
X! See if we have a buffer by that name
X
Xloop_buffer := get_info (buffers, eve$kt_first);
Xchange_case (buffer_name, upper);       ! buffer names are uppercase
Xerase (eve$choice_buffer);
X
Xloop
X    exitif loop_buffer = 0;
X    loop_buffer_name := get_info (loop_buffer, eve$kt_name);
X    if buffer_name = loop_buffer_name then
X        found_a_buffer := 1;
X        how_many_buffers := 1;
X        exitif 1;
X    else
V        if buffer_name = substr (loop_buffer_name, 1, length (buffer_name)) th
Xen
X            eve$add_choice (loop_buffer_name);
X            possible_buffer := loop_buffer;
X            possible_buffer_name := loop_buffer_name;
X            how_many_buffers := how_many_buffers + 1;
X        endif;
X    endif;
X    loop_buffer := get_info (buffers, "next");
Xendloop;
X
Xchange_case (buffer_name, lower);       ! for messages
Xif found_a_buffer then
X    dispose_of_buffer (loop_buffer);
Xelse
X    if get_info (eve$choice_buffer, eve$kt_record_count) > 0 then
X        if how_many_buffers = 1 then
X            dispose_of_buffer (possible_buffer);
X        else
X            change_case (buffer_name, lower);
X            eve$display_choices
X                 (fao ("Ambiguous buffer name: !AS", buffer_name));
X        endif;
X    else
X        message (fao ("Buffer !AS not found.", buffer_name));
X    endif;
Xendif;     
X
Xeve$set_status_line (current_window);
X
Xendprocedure;
X
X!
X! Dispose of buffer.
X!    Procedure will identify any windows to which the buffer is 
X!    currently mapped, massage these appropriately, delete the
X!    buffer unless it is the last normal editing buffer, and
X!    map the next editing buffer to the appropriate windows.
X!
X! Parameters:
X!
X!       target_buffer          Buffer variable identifying the buffer
X!                                  to be deleted - input
X!
Xprocedure dispose_of_buffer (target_buffer)
X
Xlocal window_to_change,         ! Target window for remapping
X      this_window,              ! Current cursor window, to be returned to
X      mapped_to,                ! Number of windows to which buffer is mapped
X      buffer_name,              ! Name of target buffer
X      next_buffer,              ! Buffer to replace target in windows
X      this_position;            ! Current position
X
Xon_error
X    ! Lots of different errors possible from write_file, doesn't matter here
X    set (success, on);
X    message (fao ("Will not delete; could not write buffer !AS",
X                  buffer_name));
X    return;
Xendon_error;
X
X! Check for non-deletable target buffer
X
Xif (get_info (target_buffer, "permanent")) or 
X   (get_info (target_buffer, "system"))       then
X    buffer_name := get_info (target_buffer, eve$kt_name);
X    message (fao ("Buffer !AS cannot be deleted", buffer_name));
X    return;
Xendif;
X
Xeve$check_bad_window;
Xthis_position := mark (none);                   
Xthis_window := current_window;
X
Xmapped_to := get_info (target_buffer, "map_count");
X
Xif mapped_to > 1 then           ! If the target buffer is mapped to two
X    eve_one_window;             ! windows, return to one window format.
X    mapped_to := 1;
Xendif;
X
Xif mapped_to then
X    ! Identify the buffer which will replace the one deleted:
X
X    next_buffer := get_info (buffers, eve$kt_last);
X
X    if next_buffer = 0 then 
X        next_buffer := get_info (buffers, eve$kt_first);
X    endif;
X
X    if next_buffer = target_buffer then
X        next_buffer := get_info (buffers, "previous");
X        if next_buffer = 0 then
X            next_buffer := get_info (buffers, "next");   ! Back to target
X            next_buffer := get_info (buffers, "next");
X        endif;
X    endif;
X
X    if ((next_buffer = 0) or (next_buffer = target_buffer)) or 
X       (get_info (next_buffer, "system")) then
X        buffer_name := get_info (target_buffer, eve$kt_name);
V        message (fao ("Cannot delete buffer !AS, no other buffers", buffer_nam
Xe));
X        return;
X    endif;
X
X! Change windows to which the buffer is mapped:
X
X    if eve$x_number_of_windows = 1 then         ! One window only
X        window_to_change := current_window;
X        map (eve$main_window, next_buffer);
X    else                                        ! Two windows, change one
X        if target_buffer = get_info (eve$top_window, "buffer") then
X            window_to_change := eve$top_window;
X        else
X            window_to_change := eve$bottom_window;
X        endif;
X        if window_to_change = current_window then
X            eve_other_window;
X        endif;
X        unmap (window_to_change);
X        map (window_to_change, next_buffer);
X        eve$set_status_line (window_to_change);
X    endif;
Xendif;
X
X! Check to write buffer before deleting:
X
Xmessage (eve$kt_null);
Xbuffer_name := get_info (target_buffer, eve$kt_name);
X
Xif (get_info (target_buffer, "modified")) and
X    (not (get_info (target_buffer, "no_write"))) then
X    if eve$insist_y_n (fao ("Write buffer !AS? ", buffer_name)) then
X        if eve$x_trimming then
X            message ("Trimming buffer...");
X            eve$trim_buffer (target_buffer);
X            message ("Trimming completed");
X        endif;
X        write_file (target_buffer);
X    endif;
X    set (no_write, target_buffer);
Xendif;  
X
Xdelete (target_buffer);
X
Xif window_to_change <> 0 then
X    update (window_to_change);
Xendif;
X
Xif get_info (this_window, "visible") then
X    position (this_window);
Xendif;
X
Xendprocedure;
$ GoSub Convert_File
$ Exit