PROCEDURE	cjc_fortran_compile

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  TPU Procedure to FORTRAN-compile the current buffer, and in case there
!  are errors, DISPLAY the first ERROR in the  listing-file in the other
!  editing window (creating another window if it doesn't exist)
!  If there are errors, sets EVE's search-target to "FORT-"  to aid in
!  finding any other errors
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

	LOCAL	fortname ,
		listname ,
	    	typename ,
	    	basename ,
		devicename ,
		directname ,
		a_buffer ,
		b_buffer ,
		this_position ,
		this_buffer ,
		list_buffer ,
	     	list_window ,
		fortran_error_range ;

	ON_ERROR

		if  ( error = tpu$_createfail )  then
			message ( "Could not create DCL subprocess" ) ;
			return ( 1 ) ;
		endif ;

!  Procedure searches for  "FORT-"  to find error-messages; if there are
!  none, send message to user and restore the prior editing context.

		if  ( error = tpu$_strnotfound )  then
			position ( this_position ) ;
			message ( "Compile successful." ) ;

			if ( eve$x_number_of_windows = 2 )  then
			    if  ( ( b_buffer = 0 )
			       or ( b_buffer = list_buffer ) )  then
				eve_one_window ;
			    else
				eve_other_window ;
				map ( current_window , b_buffer ) ;
				eve_other_window ;
			    endif ;
			endif ;

			delete ( list_buffer ) ;
			return ( 1 ) ;

		endif ;

	ENDON_ERROR ;

	if  ( eve$x_dcl_process = 0 )  then
	   	message ( "Creating DCL subprocess... " ) ;
		eve$x_dcl_process  :=  create_process ( eve$dcl_buffer ,
			"$ set noon " ) ;
	endif ;

	this_buffer   :=  current_buffer ;
	this_position :=  mark ( NONE ) ;
	if ( eve$x_number_of_windows = 2 ) then
		eve_other_window ;
		b_buffer :=  current_buffer ;
		eve_other_window ;
	else
                b_buffer := 0 ;
	endif ;

!  Write out the current buffer, and parse its file-name:

	fortname      :=  write_file ( current_buffer ) ;
	basename      :=  file_parse ( fortname , '' , '' , NAME ) ;
	typename      :=  file_parse ( fortname , '' , '' , TYPE ) ;
	devicename    :=  file_parse ( fortname , '' , '' , DEVICE ) ;
	direcname     :=  file_parse ( fortname , '' , '' , DIRECTORY ) ;
	listname      :=  basename + '.LIS' ;

        if ( index ( typename , 'FOR' ) = 0 )  then
            message ( 'Not a FORTRAN file.  No compilation attempted' ) ;
            return ( 0 ) ;
        endif ;

	message ( " Compiling " + fortname + '  with listfile:  ' + listname ) ;
	send 	(
		"$ for/extend/lis/cont=99 "
                   + devicename + direcname + basename ,
		eve$x_dcl_process
		) ;

!  If a buffer with listname exists, erase it; else create one.  Then
!  read in the list-file and search for error messages.

	a_buffer  :=  get_info ( BUFFERS , eve$kt_last ) ;

	loop
		exitif  ( a_buffer = 0 ) ;
		exitif  ( listname = get_info ( a_buffer , "name" ) ) ;
		a_buffer  :=  get_info ( BUFFERS , "previous" ) ;
	endloop ;

	if ( a_buffer <> 0 )  then
		list_buffer := a_buffer ;
		erase ( list_buffer ) ;
	else
		list_buffer :=  create_buffer ( listname ) ;
	endif ;


	position  ( beginning_of ( list_buffer ) ) ;
	read_file ( listname ) ;
	position  ( beginning_of ( list_buffer ) ) ;
	
	fortran_error_range  :=  search ( "FORT-" , FORWARD ) ;

!  If there are error messages, display the list-file in the other
!  window (creating it if necessary), positioning the window to
!  center the message.  If the search for error-messages fails, the
!  ON_ERROR section messages "Compile successful" and restores the
!  prior editing context, insofar as possible.

	if ( fortran_error_range <> 0 )  then
		if ( eve$x_number_of_windows = 2 )  then
			eve_other_window ;
			if ( current_buffer <> list_buffer )  then
				map ( current_window , list_buffer ) ;
			endif ;
		else
			unmap ( eve$main_window ) ;
			map ( eve$top_window , this_buffer ) ;
			eve$set_status_line ( eve$top_window ) ;
			update ( eve$top_window ) ;
			map ( eve$bottom_window , list_buffer ) ;
			eve$x_number_of_windows := 2 ;
			eve$x_this_window  :=  eve$bottom_window ;
		endif ;

		eve$position_in_middle ( fortran_error_range ) ;
		eve$set_status_line  ( current_window ) ;
		update ( current_window ) ;
		eve_other_window ;
		eve$x_target  :=  'FORT-' ;
		message ( "EVE search target 'FORT-' for additional errors" ) ;
		
	endif ;

	return ( 0 ) ;

ENDPROCEDURE ;