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

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

+-+-+-+ Beginning of part 2 +-+-+-+
X    !
X    ! Now make it visible
X    Position(Beginning_Of(Lb_Help_Buffer));
X    Map(LB_Help_Window, LB_Help_Buffer);
X    Update(LB_Help_Window);
XElse
X    !
X    ! Get rid of our windows;
X    UnMap(LB_Help_Window);
X    Delete(LB_Help_Window);
X    Delete(LB_Help_Buffer);
XEndIf;
XEndProcedure;
X`012
Xprocedure LB_find_buffer(buffer_name)
X!
X! Purpose: Locate a buffer of a specified name.  Returns the buffer variable.
X!
XLocal
X    a,b
X    ;
Xa := buffer_name;
Xedit(a,TRIM,UPPER);
Xb := get_info(buffers,"first");
XLoop
X    exitif b = 0;
X    exitif get_info(b,"name") = a;
X    b := get_info(buffers,"next");
Xendloop;
X
Xreturn b;
Xendprocedure;
X
X`012
XProcedure LB_next_buffer(Direction)
X!
X! Highlights the next buffername if one can be found.  Leaves the global
X! variable LB_Current_Buffer_Range as a range highlighting the buffer name.
X!
X!
XLocal
X    a,b
X    ;
X
XOn_Error
X    If (Error = TPU$_EndOfBuf) or (Error = TPU$_BegOfBuf) Then
X        Message("No More Buffers.");
X        Return;
X    EndIf;
XEndOn_Error;
X!
X! Search for the line containing the buffer name, remembering to start
X! after or before the current position so that we do not simply find the
X! same line.
XIf Direction = Forward Then
X    If Get_Info(LB_Current_Buffer_Range,"Type") = Range Then
X        Position(End_Of(LB_Current_Buffer_Range));
X        Move_Horizontal(1);
X    EndIf;
X    A := search(LB_Buffer_Name_Pattern,Forward);
XElse
X    If Get_Info(LB_Current_Buffer_Range,"Type") = Range Then
X        Position(Beginning_of(LB_Current_Buffer_Range));
X        Move_Horizontal(-1);
X    EndIf;
X    A := search(LB_Buffer_Name_Pattern,Reverse);
XEndIf;
X!
X! If we found a line containning a buffer name, make it visible and current.
XIf Get_Info(A,"Type") = Range then
X    position(beginning_of(a));
X    LB_Current_Buffer_Range := create_range(Beginning_of(A),End_of(A),Reverse);
X    LB_Current_Buffer_Name := substr(LB_Current_Buffer_Range,1,
X                                     Length(LB_Current_Buffer_Range));
X    Update(Info_Window);
XElse
X    Message("No More Buffers.");
XEndIf;
XEndProcedure;
X`012
XProcedure LB_write_buffer
X!
X! Writes out the currently selected buffer and updates the screen.
X!
X! If there is no filename associated with the buffer, it is prompted for.
X!
XLocal
X    A,`009`009`009! A temporary variable
X    The_Buffer,`009`009! To be written.
X    Old_Name,`009`009! of the output file.
X    New_Name,`009`009! of the just written name.
X    Old_Name_State, `009! 0 no old name at all, 1 only input filename,
X                        ! 2 had an output filename
X    Modified_State`009! of the buffer before writing.
X    ;
X!
X! Get the buffer variable for the current buffer
XThe_Buffer := LB_find_buffer(LB_Current_Buffer_Name);
X!
X! Set a flag that indicates if the buffer was modified.
XModified_State := get_info(The_Buffer,"Modified");
X!
X! Get the name of the output file.
XOld_Name := Get_Info(The_Buffer,"Output_File");
XIf Old_Name = 0 Then
X    ! If no output file name is present, get the input file name.
X    Old_Name := Get_Info(The_Buffer,"File_Name");
X    If Old_Name = "" Then
X        ! If no input filename is present, prompt for a name.
X        eve$prompt_string("",New_Name,
X            "Enter a filename to write buffer "+LB_Current_Buffer_Name+
X             ": ",
X            "Buffer "+LB_Current_Buffer_Name+" not written.");
X        Update(LB_Help_Window);
X        If New_Name = "" Then  Return; EndIf;
X        Old_Name_State := 0; !Had no name at all.
X    Else
X        Old_Name_State := 1; !Had only an input filename
X    EndIf;
XElse
X    !We had an output filename. Is it the same as the input name? (state=1)
X    Old_Name_State := 2;
X    If Old_Name = Get_Info(The_Buffer,"File_Name") Then
X        Old_Name_State := 1;
X    EndIf;
XEndIf;
X!
X! If necessary trim the file before writing
XIf eve$X_Trimming Then Eve$Trim_Buffer(The_Buffer); EndIf;
X!
X! Write the file out saving the resulting name.
XIf Old_Name_State = 0 Then
X    New_Name := write_file(The_Buffer, New_Name);
XElse
X    New_Name := write_file(The_Buffer);
XEndIf;
XSet(Output_File, The_Buffer, New_Name);
X!
X! If the buffer had been modified, remove the ", Modified" from the screen.
XPosition(Beginning_Of(LB_Current_Buffer_Range));
XIf Modified_State Then
X    A := search(", Modified",forward,exact);
X    Erase(A);
XEndIf;
X!
X! If the file had had an output filename replace it with the new one,
X! Otherwise insert a line specifing the new name.
XNew_Name := Meh_Capitalize(New_Name);
XPosition(Beginning_Of(LB_Current_Buffer_Range));
XCase Old_Name_State from 0 to 2
X[0] :`009! Had no name at all.
X    Move_Vertical(2);
X    If Mark(None) <> End_Of(Show_Buffer) Then
X        Split_Line;
X        Move_Vertical(-1);
X    EndIf;
X    Copy_Text("  Output File: ");
X    Copy_Text(New_Name);
X[1] :`009! Only had an input filename.
X    A := Search("  Input  File:", forward, exact);
X    Position(Beginning_Of(A));
X    Move_Vertical(1);
X    Split_Line;
X    Move_Vertical(-1);
X    Copy_Text("  Output File: ");
X    Copy_Text(New_Name);
X[2] :`009! Had an output filename.
X    A := search(Old_Name, forward, no_exact);
X    Position(Beginning_of(A));
X    Erase(A);
X    Copy_Text(New_Name);
XEndCase;
X!
X! Update the display
XPosition(Beginning_Of(LB_Current_Buffer_Range));
XUpdate(Info_Window);
X
XEndProcedure;
X`012
XProcedure LB_Erase_Buffer(A_Buffer)
X!
X! The specified buffer is erased and removed from the list.
X! If the buffer being erased is A_Buffer, then a new one is made the
X! selected one.
X!
XLocal
X    The_Buffer,
X    System_State,`009!System buffers do not go away but simply get emptied.
X    Modified_State,
X    Record_Count,
X    Was_A_Buffer,
X    A,B
X    ;
XOn_Error
X    If error = TPU$_NoEOBStr Then
X        A := "";
X    EndIf;
XEndOn_Error;
X
XThe_Buffer := LB_find_buffer(LB_Current_Buffer_Name);
XSystem_State := get_info(The_Buffer,"System");
XModified_State := get_info(The_Buffer,"Modified");
XRecord_Count := get_info(The_Buffer,"Record_Count");
XWas_A_Buffer := (The_Buffer = A_Buffer) ;
X!
X! Make sure the twit does not try to erase the show buffer.
XIf The_Buffer = Show_Buffer Then
X    Message("You can not erase this buffer because I am using it, twit!");
X    Return;
XEndIf;
X!
X! If the buffer was marked modified, ask if buffer should be written first
X! unless buffer marked nowrite.
XIf Modified_State and (Not get_info(The_Buffer,"No_Write")) Then
X    eve$prompt_string("",A,
X        "Write buffer "+LB_Current_Buffer_Name+
X        "? [Yes/No] : ",
X        "Buffer "+LB_Current_Buffer_Name+" will be written.");
X    Update(LB_Help_Window);
X    A := substr(A,1,1);
X    If (A = "") or (A = "Y") or (A = "y") Then
X        LB_write_buffer;
X    Else
X        Message("Buffer "+LB_Current_Buffer_Name+" not written out.");
X    EndIf;
X
XEndIf;
X!
X! Remove from the list if buffer was deleted.
Xposition(beginning_of(LB_Current_Buffer_Range));
XIf System_State Then
X    ! It is a system buffer which do not get deleted, only erased.
X    Erase(The_Buffer);
X    ! We will simply change the line count to "Empty" and remove the
X    ! ", Modified" if it was present.
X    If Record_Count <> 0 then
X        A := search("Lines: ",forward, exact);
X        Position(Beginning_Of(A));
X        Erase(A);
X        B := span(eve$x_digit_characters);
X        A := search(B,forward);
X        Erase(A);
X        Copy_Text("Empty");
X    EndIf;
X
X    If Modified_State Then
X        A := search(", Modified",forward, exact);
X        Erase(A);
X    EndIf;
X
X    Position(Beginning_of(LB_Current_Buffer_Range));
X    Update(Info_Window);
XElse
X    !
X    ! A user buffer, it can truely go away, but first if it is mapped and
X    ! there are two windows, we need to do some special processing.
X    ! If there is only one window, there is nothing to worry about.
X    If (Eve$X_Number_Of_Windows = 2) and
X       (Get_Info(The_Buffer,"Map_count") <> 0) Then
X        !
X        ! The buffer is either mapped to the top window or the bottom window.
X        ! Figure out which one.
X        If Get_Info(Eve$Top_Window,"Buffer") = The_Buffer Then
X            !
X            ! It is mapped to the top window.
X            ! Get the buffer associated with the bottom window.
X            A := Get_Info(Eve$Bottom_Window,"Buffer");
X        Else
X            !
X            ! It must be mapped to the bottom window.
X            ! Get the buffer associated with the top window.
X            A := Get_Info(Eve$Top_Window, "Buffer");
X        EndIf;
X        !
X        ! Set for only one window now.
X        Eve$X_Number_of_Windows := 1;
X        Unmap(Info_Window);
X        Unmap(Eve$Top_Window);
X        Unmap(Eve$Bottom_Window);
X        Map(Eve$Main_Window,A);
X        Eve$Set_Status_Line(Eve$Main_Window);
X        Eve$X_This_Window := eve$main_window;
X        !
X        ! And remap the buffer directory window
X        Map(Info_Window, Show_Buffer);
X    EndIf;
X    !
X    ! Ok to delete the buffer
X    Delete(The_Buffer);
X    !
X    ! Now update the list of buffers.
X    loop
X        erase_line;
X        A := current_character;
X        ExitIf A <> " ";
X    endloop;
X    !
X    ! Since the lines containing the name are now gone, the range is not
X    ! really valid.
X    LB_Current_Buffer_Range := 0;
X    !
X    ! If we have erased all buffers listed (record count in the show_buffer
X    ! is less than 2) then we need to create a buffer called MAIN.
X    ! Get its info into the show_buffer.
X    If get_info(Show_Buffer,"record_count") < 2 then
X        A := Create_Buffer("Main");
X        Set(Eob_Text, A,"[End of File]");
X        Set(Margins, A, eve$x_default_left_margin,
X            Get_Info(eve$main_window, "width")-eve$x_default_right_margin);
X        LB_List_Buffer(A);
X        Position(Beginning_Of(Show_Buffer));
X        Update(Info_Window);
X        A := "";
X    EndIf;
X    !
X    ! If at the end of the buffer, position at the previous buffername
X    ! otherwise position at the next buffername.
X    If Current_Line = "" then
X        LB_next_buffer(Reverse);
X    Else
X        LB_next_buffer(Forward);
X    EndIf;
X    If Was_A_Buffer Then
X        A_Buffer := LB_find_buffer(LB_Current_Buffer_Name);
X    EndIf;
XEndIf;
XEndProcedure;
X`012
XProcedure LB_Mark
X!
X! Marks the current buffer as modified.
X!
XLocal
X    A,
X    The_Buffer
X    ;
X!
X! Get the current buffer
XThe_Buffer := LB_Find_Buffer(LB_Current_Buffer_Name);
X!
X! Mark it modified if it isn't already
XIf Not Get_Info(The_Buffer,"Modified") Then
X    Position(The_Buffer);
X    Split_Line;Append_Line;
X    Position(End_Of(LB_Current_Buffer_Range));
X    A := Search("State:", forward, exact);
X    Position(A);
X    A := Search(".", forward);
X    Position(Beginning_Of(A));
X    Copy_Text(", Modified");
X    Position(End_Of(LB_Current_Buffer_Range));
X    Update(Info_Window);
XEndIf;
X
XEndProcedure;
X`012
XProcedure LB_UnMark
X!
X! Marks the current buffer as not modified if it is modified.
X!
X! Does so by writing the file to the null device.
XLocal
X    A,
X    The_Buffer,
X    Its_File,
X    Success_State
X    ;
X!
X! Find the buffer to be marked
XThe_Buffer := LB_Find_Buffer(LB_Current_Buffer_Name);
X!
X! If it is modified then do our thing.
XIf Get_Info(The_Buffer,"Modified") Then
X    Its_File := Get_Info(The_Buffer,"Output_File");
X    Success_State := Get_Info(System,"Success");
V    Set(Output_File,The_Buffer,"NL:");`009!This is needed to clear the modified
X bit.
X    Set(Success,Off);`009`009!Supresses message about writing.
X    Write_File(The_Buffer);`009! Clears the modified bit.
X    !
X    ! Restore the output filename
X    If Its_File = 0 Then
X        Set(Output_File,The_Buffer,Get_Info(The_Buffer,"File_name"));
X    Else
X        Set(Output_File,The_Buffer,Its_File);
X    EndIf;
X    !
X    ! Restore the message state.
X    If Success_State Then Set(Success,On); EndIf;
X    !
X    ! Now update the screen by removing the ", Modified" phrase.
X    Position(End_Of(LB_Current_Buffer_Range));
X    A := Search(", Modified",forward, exact);
X    Erase(A);
X    Update(Info_Window);
XEndIf;
XEndProcedure;
X`012
XProcedure LB_Create_Buffer
X!
X! Creates a new empty buffer which then becomes the current buffer.
X!
XLocal
X    Its_Name,
X    The_Buffer,
X    Was_At_Beginning
X    ;
X
XOn_Error
X    If Error = TPU$_DupBufName Then
X        Message("Buffer "+Meh_Capitalize(Its_Name)+" already exists.");
X        Return;
X    EndIf;
XEndOn_Error;
X!
X! Get a name for this buffer
Xeve$prompt_string("",Its_Name,
X        "Enter a name for the buffer: ",
X        "No buffer created.");
XUpdate(LB_Help_Window);
XIf Its_Name <> "" Then
X    The_Buffer := Create_Buffer(Its_Name);
X    Set(Eob_Text, The_Buffer,"[End of File]");
X    Set(Margins, The_Buffer, eve$x_default_left_margin,
X            Get_Info(eve$main_window, "width")-eve$x_default_right_margin);
X    Position(Show_Buffer);
X    Was_At_Beginning := (Mark(None) = Beginning_Of(Show_Buffer));
X    If Not Was_At_Beginning Then Move_Horizontal(-1); EndIf;
X    LB_List_Buffer(The_Buffer);
X    If Was_At_Beginning Then Split_Line; EndIf;
X    Update(Info_Window);
X    LB_Next_Buffer(Reverse);
XEndIf;
XEndProcedure;
X`012
XProcedure LB_Help
XLocal
X    a
X    ;
Xerase(help_buffer);
Xmap(eve$choice_window, help_buffer);
Xhelp_text("tpuhelp","list_buffers",off, help_buffer);
Xset(status_line, eve$choice_window, reverse,"Press any key to continue.");
Xupdate(info_window);
Xupdate(eve$choice_window);
Xa := read_key;
Xunmap(eve$choice_window);
Xupdate(info_window);
XEndProcedure;
X`012
X        procedure key_index ( key )        ! Get the index of a key
X                !-
X                ! The key index will be on of the following values.
X                !   printing or shift_printing  ->  the character
X                !   control or shift_control    ->  the character
X                !   keypad or shift_keypad      ->  the terminator from the
X                !                                   escape sequence
X                !   function or shift_Function  ->  the number generated by
X                !                                   the function key
X                !+
X                   return (key - ((key/65536) * 65536 )) / 256;
X        endprocedure; ! key_index
X
X        procedure key_type ( key )         ! Get the type of a key
X                ! 0 = "printing";
X                ! 1 = "keypad";
X                ! 2 = "function";
X                ! 3 = "control";
X                ! 4 = "shift_printing";
X                ! 5 = "shift_keypad";
X                ! 6 = "shift_function";
X                ! 7 = "shift_control";
X            Return  ((( key * 16 ) / 16 ) / 16777216 );
X        endprocedure;
X
X        procedure key_type_ascii ( key )         ! Get the type of a key
X            case ((( key * 16 ) / 16 ) / 16777216 ) from 0 to 7
X                [0]: return "printing";
X                [1]: return "keypad";
X                [2]: return "function";
-+-+-+-+-+ End of part 2 +-+-+-+-+-