!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!  TPU procedure to do global search of a list of buffers entered from the
!  keyboard for a pattern and to delete all lines in which the pattern occurs.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

PROCEDURE cjc_del_pat_lines

LOCAL 	input_file    ,
	target_str    ,
	target_range  ,
	this_position ,
	this_buffer   ,
	work_buffer   ,
	work_buf_name ;

ON_ERROR

        if ( ERROR = TPU$_DUPBUFNAME ) then
            if ( eve$prompt_string ( 	
                                   "" ,
                                   work_buf_name ,
                                   "buffer " + work_buf_name
                                             + " already exists. "
                                             + "Enter new name:  " ,
                                   "No string entered --  returning"
                                   ) )  then
                work_buffer  :=  create_buffer ( work_buf_name , input_file ) ;
            else
                eve$position_in_middle ( this_position ) ;
                return ( 0 ) ;
            endif ;

	else 	if ( ERROR <> TPU$_STRNOTFOUND )  then
	    message ( 'FATAL ERROR in substitution-process' ) ;
            map ( this_window , this_buffer ) ;
            eve$position_in_middle ( this_position ) ;
	    return ( 1 ) ;
	endif ; endif ;

ENDON_ERROR;

if ( 0 = eve$prompt_string
			( 	
			"" ,
			target_str ,
			"Delete lines containing what target-string?  " ,
			"No string entered--no deletions made"
	 		) )   then
	return;
endif ;

this_position  :=  mark ( NONE ) ;
this_buffer    :=  current_buffer ;
this_window    :=  eve$x_this_window ;
work_buf_name  :=  'D_P_L_work_buffer' ;

loop

	exitif ( 0 = eve$prompt_string  (
                                        "" ,
     		     		        input_file ,
				        "Input file (RET to quit):  " ,
		                        "Edit session completed."
            	 		        ) ) ;

       	work_buffer  :=  create_buffer (
                                       work_buf_name ,
                                       input_file
                                       ) ;

        position ( beginning_of ( work_buffer ) ) ;

        set (
            OUTPUT_FILE ,
            work_buffer ,
            input_file
            ) ;

	target_range  :=  search ( target_str, FORWARD ) ;

	loop

	    exitif (  ( target_range = 0 )
	       or ( mark ( NONE )  =  end_of ( current_buffer )) ) ;

  	    if ( beginning_of ( target_range )
		    <=  beginning_of ( search ( LINE_END , FORWARD )) ) then

		erase_line ;
		target_range  :=  search ( target_str, FORWARD ) ;
	        position ( search ( LINE_BEGIN , REVERSE ) ) ;

	    else    move_vertical ( 1 ) ;

	    endif ;
		
	endloop;

	write_file ( work_buffer ) ;
	delete ( work_buffer ) ;

endloop ;

map ( this_window , this_buffer ) ;
eve$position_in_middle ( this_position ) ;
	
ENDPROCEDURE ;





!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  TPU procedure to search through the current_buffer for a pattern entered
!  from the keyboard, and delete the remainders of lines containing the
!  pattern -- e.g., if the current buffer has the output of
!  "dir/noheader/notrailer" and the pattern is ";" , then the effect is to
!  strip off all the version-numbers.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

PROCEDURE	cjc_del_remain

LOCAL	this_position ,
        where         ,
        range_start   ,
        range_end     ,
        target_str    ;

ON_ERROR
        if  ( error <> TPU$_STRNOTFOUND )  then
            eve$position_in_middle ( this_position ) ;
            message ( "Fatal error" ) ;
            return ;
        endif ;
ENDON_ERROR ;

if ( 0 = eve$prompt_string
			( 	
			"" ,
		      	target_str ,
		   	"Delete lines after what target-string?  " ,
		    	"No string entered--no deletions made"
	 	    	)
        )   then   return ;
endif ;

this_position  :=  mark ( NONE ) ;

if ( eve$x_select_position = 0 )  then
        position (  beginning_of ( current_buffer ) ) ;
        end_position  :=  end_of ( current_buffer ) ;
else
        if this_position < eve$x_select_position then
            end_position  :=  eve$x_select_position ;
        else
            position ( eve$x_select_position ) ;
            end_position  :=  now_position ;
        endif ;
endif ;

loop
        exitif ( mark ( NONE )  =  end_of ( current_buffer ) ) ;
        where  :=  search ( target_str , FORWARD ) ;
        exitif ( where = 0 ) ;
        exitif ( beginning_of ( where ) > end_position ) ;
        position ( where ) ;
        range_start :=  mark ( NONE ) ;
        position ( search ( LINE_END , FORWARD ) ) ;
        range_end   :=  mark ( NONE ) ;
        if ( range_end <> range_start ) then
            move_horizontal ( -1 ) ;
            range_end  :=  mark ( NONE ) ;
        endif ;
        position ( range_start ) ;
        erase ( create_range ( range_start , range_end ) ) ;
        move_vertical ( 1 ) ;
        move_horizontal ( - current_offset ) ;

endloop ;

eve$position_in_middle ( this_position ) ;

ENDPROCEDURE ;