[comp.os.vms] TPU List_Buffers.1_of_3

UA_RLP@nuhub.acs.northeastern.EDU (Richard Pieri aka XENON - The Heavy Metal Warrior) (06/01/88)

...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.00 26-May-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user UA_RLP
$! on  6-APR-1866 20:07:23.75.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 3 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 1 file:
$!        LIST_BUFFERS.TPU
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.00 26-May-1988 requires VMS V4.4 or higher."
$ EXIT 44 
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE 
) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ); IF s_x = "+" THEN r_skip 
:= SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <> 0 THEN s_x := ""
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF
; IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = "V" THEN s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL
( 1 ); ENDIF; IF s_x = "X" THEN s_x := ""; IF i_append_line <
> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> "" THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL( 1 
); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH( "`"
, FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 )
; IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) )
; COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors
, "SYS$COMMAND" ); ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "LIST_BUFFERS.TPU"
$ CHECKSUM_IS = 1897237734
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X!
X! List_Buffers.Tpu
X!
X! Author: Ray Beaupre, Project Software and Development, Inc
X!         20 University Road, Cambridge, MA 02138
X!
X! Purpose: An EVE command to list the buffers currently in use.
X!`009Provides a Buffer Directory Editor to manipulate the list.
X!
X! Notes:
X!`009Include this file into your TPU section.
X!`009Before saving, define the variable EVE$ARG1_LIST_BUFFERS as "STRING"
X!
X!    There are 3 options to this command:
X!`009`009ALL -- which will list all buffers
X!`009`009USER -- the default which will list only user buffers.
X!`009`009SYSTEM -- which will list only system buffers.
X!`009
X!`009Once listed, the buffer directory can be manipulated by the commands:
X!`009`009Erase -- the buffer contents are deleted and possibly the
X!`009`009`009the buffer itself.  If a buffer is marked Modified,
X!`009`009`009one will be prompted for permission to erase.
X!`009`009Mark -- marks the buffer as being modified.
X!`009`009UnMark -- marks the buffer as not being modified.
X!`009`009Select -- The selected buffer becomes the current buffer
X!`009`009`009upon exiting this procedure.
X!`009`009Write -- the contents of the buffer are written out.
X!`009`009Quit -- exits this procedure.
X!`009`009Next -- moves cursor to next buffer.
X!`009`009Previous -- moves cursor to previous buffer.
X!`009`009Create -- creates a new buffer
X!
X!`009
X!
X! Modifications:
X!`009MEH on  1-Jul-1986 -- Added the LB_Attach option
X!`009MEH on 22-Aug-1986 -- Added the eve$local_init procedure to be used
X!`009with the EVEPlus builder
X!`009MEH on 17-Oct-1986 -- Added check for a keymap list.
X!`009MEH on  3-Nov-1986 -- To mark current position in an attempt to
X!`009kept the cursor in the correct window when we leave.
X!
X!`009RLP on 11-Mar-1988 -- changed eve$local_init to tpu$local_init.
X!`009 'List Buffers' command now works properly (I hope!)
X!`009RLP on 14-Mar-1988 -- changed Bold mode for directory to Reverse
X!`009 for terminals that don't support Bold mode.
X`012
Xprocedure tpu$local_init
X!
X! List Buffers requires one argument.
Xeve$arg1_list_buffers := "string";
Xendprocedure;
X`012
Xprocedure eve_list_buffers(option_parameter)
XLocal
X    This_position,
X    Save_Buffer,
X    Save_Window,
X    Save_Number_of_Windows,
X    Selected_Buffer,
X    This_Buffer,`009! The buffer currently being displayed.
X    Buffer_Type,`009! of This_Buffer
X    Option_P,
X    Option`009`009! 0 User buffers, 1 System buffer, 2 All buffers
X    ;
X!
X! Determine listing option.
XOption_P := substr(Option_Parameter,1,1);
XEdit(Option_P,UPPER);
XIf Option_P = "S" Then
X    Option := 1;`009`009! System Buffers only
XElse If Option_P = "A" Then
X    Option := 2;`009`009! All buffers
XElse`009
X    Option := 0;`009`009! User buffers only.
XEndIf;EndIf;
X!
X! Save current buffer and window.
XThis_Position := Mark(Reverse);
XSave_Buffer := Current_Buffer;
XSave_Window := Current_Window;
X
X!
X! If a buffer is erased that was mapped and there were two windows on the
X! screen, there will only be one window when we get back.  Thus instead
X! of mapping to the save_window, we need to map to the main window.
XSave_Number_Of_Windows := Eve$X_Number_Of_Windows;
X!
X! Prepare the buffer directory buffer and windows
XLB_Initialize_List_Buffers;
X!
X! Start with the current buffer
XCase Option from 0 to 2
V[0] : If Not Get_Info(Save_Buffer,"System") Then LB_List_Buffer(Save_Buffer);En
XdIf;
X[1] : If Get_Info(Save_Buffer,"System") Then LB_List_Buffer(Save_Buffer);EndIf;
X[2] : LB_List_Buffer(Save_Buffer);
XEndCase;
X!
X! Now do the rest of the buffers.
XThis_Buffer := get_info(buffers,"first");
XLoop
X    Exitif This_Buffer = 0;
X    Buffer_Type := Get_Info(This_Buffer,"system");
X    If This_Buffer <> Save_Buffer Then
X        Case Option from 0 to 2
X        !
X        ! User Buffers only
X        [0] : If Not Buffer_Type Then LB_List_Buffer(This_Buffer);EndIf;
X        !
X        ! System buffers only
X        [1] : If Buffer_Type Then LB_List_Buffer(This_Buffer);EndIf;
X        !
X        ! All Buffers
X        [2] : LB_List_Buffer(This_Buffer);
X        EndCase;
X    EndIf;
X    !
X    ! Advance to next buffer
X    This_Buffer := Get_Info(Buffers,"next");
XEndLoop;
X!
X! Now drop into the buffer editor, pass in the save buffer which could
X! be changed.
XSelected_Buffer := Save_Buffer;
XLB_Buffer_Directory_Editor(Selected_Buffer);
X!
X! Remove the buffer directory from the screen.
Xset(eob_text, Show_Buffer, "");
XSet(Status_Line, Info_Window, None, "");
XIf get_info(Info_Window,"visible") then UnMap(Info_Window);EndIf;
X!
X! If the number of windows changed, change the saved window to the main
X! window
XIf Save_Number_Of_Windows <> Eve$X_Number_Of_Windows Then
X    Save_Window := Eve$Main_Window;
XEndIf;
X!
X! Determine which buffer we return to.
XIf Selected_Buffer = Save_Buffer Then
X    Position(This_Position);
X    update(current_window);
XElse
X    ! If another buffer was selected, then map it to the saved window.
X    if get_info(Save_Window,"Visible") then UnMap(Save_Window);EndIf;
X    Map(Save_Window,Selected_Buffer);
X    Position(Selected_Buffer);
X    Eve$Set_Status_Line(Save_Window);
X    update(save_window);
XEndIf;
X!
X! And remove any outstanding messages from the screen
XMessage(" ");
Xendprocedure;
X`012
XProcedure LB_Initialize_List_Buffers
X!
X! Prepare the buffer which will contain the list of buffers.
Xerase(show_buffer);
Xmap (info_window, show_buffer);
Xset (Status_Line, Info_Window, Reverse,
X    fao("!60AS!20%D","Buffer Directory",0) );
Xset (insert, Show_Buffer);
Xset(eob_text,Show_Buffer,"[End of Buffer Directory]");
Xposition(end_of(show_buffer));
XLB_Buffer_Name_Pattern := Line_Begin & NotAny(" ") & REMAIN;
Xset(scrolling, info_window, on, 0, 3, 0);
XEndProcedure;
X`012
X
XProcedure LB_List_Buffer(A_Buffer)
X!
X! Formats the data concerning A_Buffer into the current buffer.
X! The buffer name is placed on a separate line and starts in column 1.
X! All other data is indented 2 spaces.
X!
XLocal
X    i,
X    FileName,
X    Output_Filename
X    ;
X
X!
X! First the name of the buffer.
XIf Mark(None) <> Beginning_Of(Show_Buffer) Then Split_Line; EndIf;
Xcopy_text(meh_capitalize(get_info(A_Buffer,"name")));
X
XSplit_Line;
X
Xi := get_info(A_Buffer,"record_count");
XIf i = 0 Then
X    Copy_Text("  Empty.");
XElse
X    copy_text(fao("  Lines: !UL.",i));
XEndIf;
X
Xi := get_info(A_Buffer,"max_lines");
XIf i <> -1 then
X    Copy_Text(fao(" Maximum Lines: !UL.",i));
XEndIf;
X
Xi := get_info(A_Buffer,"map_count");
XIf i <> 0 then
X    Copy_Text(fao("  Mapped: !UL.",i));
XEndIf;
X!
X! Display the State of the buffer
XCopy_Text("  State: ");
XIf get_info(A_Buffer,"system") then
X        Copy_Text("System, ");
XEndIf;
XIf Get_Info(A_Buffer,"Direction") = FORWARD then
X        Copy_Text("Forward");
XElse
X        Copy_Text("Reverse");
XEndIf;
XIf Get_Info(A_Buffer,"Mode") = INSERT Then
X        Copy_Text(", Insert");
XElse
X        Copy_Text(", OverStrike");
XEndIf;
Xif get_info(A_Buffer,"Modified") then
X        Copy_Text(", Modified");
XEndIf;
Xif get_info(A_Buffer,"no_write") then
X        Copy_Text(", NoWrite");
XEndIf;
XIf Get_Info(A_Buffer,"Permanent") Then
X        Copy_Text(", Permanent");
XEndIf;
X
XIf Get_Info(A_Buffer,"Key_Map_List") <> Eve$x_key_map_list Then
X    Copy_Text(", "+ MEH_Capitalize(Get_Info(A_Buffer,"Key_Map_List")));
XEndIf;
X
XCopy_Text(".");
X!
X! Display the names of the input and output files if they exist.
XFileName := get_info(A_Buffer,"file_name");
XOutput_Filename := get_info(A_Buffer,"Output_File");
XIf FileName <> "" then
X    Split_Line;
V    If Get_Info(Output_FileName,"Type") = String Then Copy_Text("  Input"); End
XIf;
X    Copy_Text("  File: "+Meh_Capitalize(FileName));
XEndIf;
X!
X! Only display the output filename if it is different then the input
X! filename.
XIf Output_Filename <> 0 Then
X    If Filename <> Output_FileName Then
X        Split_Line;
X        Copy_Text("  Output File: "+Meh_Capitalize(Output_Filename));
X    EndIf;
XEndIf;
XEndProcedure;
X`012
XProcedure LB_Buffer_Directory_Editor(A_Buffer)
X!
X! Allows one to perruse the list of buffers in the Show_Buffer.
X!
X! Various one key commands are allowed, the meanings are displayed in a
X! special help window.
X!
X! The two commands Quit and Select exit the procedure.
X!
X! The Select command will return in A_Buffer the buffer variable of the
X! current buffer name.
X!
XLocal
X    A_Key,
X    Done,
X    Select_Msg,
X    Key_Comment
X    ;
XDone := 0;
XSelect_Msg := "Please select one of the above commands.";
X!
X! Set up the help buffer and window.
XLB_List_Buffer_Help(1);
X!
X! Make the first buffer name in the list the current buffer.
XPosition(Beginning_of(Show_Buffer));
XLB_Current_Buffer_Range := 0;
XLB_Current_Buffer_Name := "";
XLB_next_buffer(Forward);
X
XUpdate(Info_Window);
XMessage(" ");
XLoop
X    A_Key := Read_Key;
X    Message(" ");
X    If Key_Type(A_Key) = 0 Then`009!Printing keys only
X        Case Ascii(Key_index(A_Key)) from '?' to 'z'
X        ['A','a'] : LB_Attach;
X        ['C','c'] : LB_Create_Buffer;
X        ['E','e'] : LB_Erase_Buffer(A_Buffer);
X        ['M','m'] : LB_Mark;
X        ['U','u'] : LB_UnMark;
X        ['S','s'] :
X            A_Buffer := LB_find_buffer(LB_Current_Buffer_Name);
X            Done := 1;
X        ['W','w'] : LB_write_buffer;
X        ['Q','q'] : Done := 1;
X        ['N','n'] : LB_next_buffer(Forward);
X        ['P','p'] : LB_next_buffer(Reverse);
X        ['?', 'H','h'] : LB_Help;
X        [Inrange] : Message(Select_Msg);
X        [Outrange] : Message(Select_Msg);
X        EndCase;
X    Else
X        !
X        ! See if the key has a comment we can deal with
X        Key_Comment := eve$lookup_comment(A_Key);
X        Edit(Key_Comment, lower );
X        If (Key_Comment = "return") or (Key_Comment = "select") then
X            A_Buffer := LB_Find_Buffer(LB_Current_Buffer_Name);
X            Done := 1;
X        Else If (Key_Comment = "move_up") or (Key_Comment = "up_arrow") Then
X            LB_Next_Buffer(Reverse);
V        Else If (Key_Comment = "move_down") or (Key_Comment = "down_arrow") The
Xn
X            LB_Next_Buffer(Forward);
X        Else If Key_Comment = "help" Then
X            LB_Help;
X        Else
X            Message(Select_Msg);
X        EndIf;EndIf;EndIf;EndIf;
X    EndIf;
X    ExitIf Done;
XEndLoop;
X
XLB_List_Buffer_Help(0);
XEndProcedure;
X`012
XProcedure LB_List_Buffer_Help(Option)
X!
X! Setups or Destroys the LB_List_Buffer_Help window.
X!`009Option=1 is setup.
X!`009Option=0 is destroy.
X!
X! Creates the buffer LB_Help_Buffer and the window LB_Help_Window.
X! Makes the window visible and overlapping EVE's command window.
X!
XIf Option Then
X    !
X    ! Create a window for help buffer
X    LB_Help_Window := Create_Window(Eve$Main_Window_Length+1,1,off);
X    Set(Video,LB_Help_Window,Reverse);
X    Set(Pad,LB_Help_Window,ON);
X    !
X    ! Setup the buffer.
X    LB_Help_Buffer := Create_Buffer("LB_Help_Buffer");
X    Set(No_Write,LB_Help_Buffer,ON);
X    Set(System,LB_Help_Buffer);
X    Set(Max_Lines,LB_Help_Buffer,2);
X    Position(Beginning_of(LB_Help_Buffer));
V    Copy_Text("Attach Create Erase Mark UnMark Select Write Quit Next Previous"
X);
X    Split_Line;
-+-+-+-+-+ End of part 1 +-+-+-+-+-