
PROCEDURE   cjc_buffer_manager

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Procedure to provide a windowing (MAC-like) buffer-manager for TPU:
!
!  DISPLAYS  buffer-name, status (modified/unmodified), type (user/system),
!  associated input-file name (in reverse order of creation);
!
!  HIGHLIGHTS currently-selected buffer
!
!  COMMANDS:
!	RETURN goes back to the buffer from which buffer_manager
!		was invoked.
!	ENTER goes to the currently-selected buffer
!	ARROW KEYS change the currently-selected buffer
!	W  writes the  currently-selected buffer to disk
!	D  deletes the currently-selected buffer from TPU's buffer-list
!		(requires confirmation if the buffer is modified; will
!		not delete system buffers)  In case one deletes the buffer
!		from which buffer_manager was invoked, buffer_manager will
!		RETURN to its predecessor in TPU's buffer-list.
!	C  invokes CJC_FORTRAN_COMPILE on the currently-selected buffer
!	KP_PERIOD prompts for a file-name, reads the file into a buffer,
!		and goes to that buffer
!	F11 prompts for, and invokes, a DCL command
!	F13 prompts for a buffer-name, and goes to that buffer
!  	CTRL_Z exits from EVE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL
   old_position ,
   old_window   ,
   old_buffer   ,
   now_buffer   ,
   tmp_buffer   ,
   buf_count    ,
   max_count    ,
   a_position   ,
   b_position   ,
   c_position   ,
   name_txt     ,
   file_txt     ,
   mod_txt      ,
   sys_txt      ,
   key_response ;

ON_ERROR
   message( "ERROR; returning to original buffer " ) ;
   unmap ( info_window ) ;
   map ( old_window , old_buffer ) ;
   position ( old_window ) ;
   eve$position_in_middle ( old_position ) ;
   eve$update_status_lines ;
   return ;
ENDON_ERROR ;

!  Save the current context for RETURN option

old_position :=  mark ( none )  ;
old_window   :=  current_window ;
old_buffer   :=  current_buffer ;

!  set up display for buffer_manager in the SHOW-BUFFER

map ( info_window , show_buffer ) ;
erase ( show_buffer ) ;
set ( status_line , info_window , REVERSE , "MANAGE  BUFFERS  &  FILES" ) ;
position ( end_of ( show_buffer ) ) ;

copy_text
   (
'NAME                            STATUS                  ASSOCIATED FILE'
   );
split_line ; split_line ;

!  display buffer-list in the info_window

buf_count  :=  0 ;
now_buffer :=  get_info ( buffers , eve$kt_last ) ;

loop
   exitif   ( now_buffer  =  0 ) ;
   if  get_info ( now_buffer , "system" )  then
      sys_txt := " system " ;
   else   sys_txt := "   USER " ;
   endif ;

   if get_info ( now_buffer , "modified" )  then
      mod_txt := "MODIFIED     " ;
   else   mod_txt := "not modified " ;
   endif ;

   file_txt  :=  get_info ( now_buffer , eve$kt_file_name ) ;
   if  ( file_txt = eve$kt_null )  then
      file_text := "none  " ;
   endif ;

   name_txt  :=  get_info ( now_buffer , eve$kt_name ) ;

   copy_text ( name_txt
      + substr ( eve$kt_spaces , 1 , 20 - length(name_txt ) )
      + mod_txt + sys_txt + file_txt ) ;

   split_line ;
   buf_count  :=  buf_count + 1 ;
   now_buffer :=  get_info ( buffers , "previous" ) ;

endloop ;


!  set up and maintain "currently-selected buffer"

position ( beginning_of ( show_buffer ) ) ;
move_vertical ( 2 ) ;

max_count   :=  buf_count ;
buf_count   :=  1 ;
now_buffer  :=  get_info ( buffers , eve$kt_last ) ;

loop		!  action-response loop

   position ( search ( LINE_BEGIN , REVERSE ) ) ;	!  highlight the
   a_position  :=  select ( REVERSE ) ;			!  currently-selected
   position ( search ( LINE_END , FORWARD ) ) ;		!  buffer
   update   ( info_window ) ;

   key_response  :=  eve$prompt_key		!  prompt for action
      (
      "RETURN--same, "
      + "ENTER--another, "
      + "PERIOD--new file, "
      + "UP,DOWN--move, "
      + "W, "
      + "D, "
      + "C:  "
           ) ;


!  invoke the action appropriate for the key pressed:

   if ( key_response = CTRL_Z_KEY )  then
      eve_exit
   endif ;

   if ( key_response = RET_KEY )  then		!  return to the buffer
      unmap ( info_window ) ;			!  from which buffer_manager
      position ( old_window ) ;			!  was invoked
      eve$position_in_middle ( old_position ) ;
      eve$update_status_lines ;
      return ;
   endif ;

   if ( key_response = ENTER )  then		!  go to the currently-
      unmap ( info_window ) ;			!  selected buffer
      map ( old_window , now_buffer ) ;
      position ( old_window ) ;
      eve$position_in_middle ( mark ( NONE ) ) ;
      eve$update_status_lines ;
      return ;
   endif ;

	if ( key_response = F11 )  then		!  invoke  eve_dcl for
		unmap ( info_window ) ;		!  DCL command
		map ( old_window , eve$dcl_buffer ) ;
		position ( old_window ) ;
		eve$update_status_lines ;
		eve_dcl ( '' ) ;
		return ;
	endif ;

	if ( key_response = F13 )  then		!  invoke eve_buffer
		unmap ( info_window ) ;
		position ( old_window ) ;
                eve_buffer ( '' ) ;
		return ;
	endif ;

   if (  ( key_response = key_name ( 'c' ) )		!  invoke
      or ( key_response = key_name ( 'C' ) ) )  then	!  cjc_fortran_compile

      unmap ( info_window ) ;
      map ( old_window , now_buffer ) ;
      position ( old_window ) ;
      if ( cjc_fortran_compile then
          unmap ( old_window ) ;
          map ( info_window , show_buffer ) ;
          set ( status_line ,
                info_window ,
                REVERSE ,
                "MANAGE  BUFFERS  &  FILES"
                ) ;
      else
          eve$update_status_lines ;
          return ;
      endif ;

   endif ;

   if ( key_response = PERIOD )  then
      unmap ( info_window ) ;
      map ( old_window , now_buffer ) ;
      position ( old_window ) ;
      eve_get_file ( "" ) ;
      return ;
   endif ;

   if    ( ( key_response = UP ) or ( key_response = LEFT ) )
	and ( buf_count > 1 ) then

      move_vertical ( - 1 ) ;
      buf_count   :=  buf_count - 1 ;
      now_buffer  :=  get_info ( BUFFERS , "next" ) ;

   else if   ( ( key_response = DOWN ) or ( key_response = RIGHT ) )
	and ( buf_count < max_count ) then

      move_vertical (   1 ) ;
      buf_count   :=  buf_count + 1 ;
      now_buffer  :=  get_info ( BUFFERS , "previous" ) ;

   else if   (    key_response = key_name ( 'w' ) )
      or ( key_response = key_name ( 'W' ) )  then

      write_file ( now_buffer ) ;
      position ( search ( LINE_BEGIN , REVERSE ) ) ;
      move_horizontal ( 20 ) ;
      b_position  :=  mark ( NONE ) ;
      move_horizontal ( 12 ) ;
      c_position  :=  mark ( NONE ) ;
      erase ( create_range ( b_position , c_position , NONE ) ) ;
      position ( b_position ) ;
      copy_text ( "not modified " ) ;
      delete ( b_position ) ;
      delete ( c_position ) ;

   else if   (    key_response = key_name ( 'd' ) )
      or ( key_response = key_name ( 'D' ) )  then

      if ( get_info ( now_buffer , "system" ) = 0 )   then

         if ( get_info ( now_buffer , "modified" ) )  then
             if ( eve$insist_y_n ( "Buffer modified: delete anyway? " ) ) then

	        erase ( select_range ) ;
                erase_line ;
                if ( buf_count = max_count )  then
                   tmp_buffer  :=  get_info ( buffers,"next") ;
                   move_vertical ( - 1 ) ;
                   buf_count   :=  max_count - 1 ;
                else   tmp_buffer  :=  get_info ( buffers,"previous") ;
                endif ;

                if ( now_buffer = old_buffer )  then
                   message ( "WARNING:  deleting origin-buffer") ;
                   old_buffer   :=  tmp_buffer ;
                   old_position :=  beginning_of ( tmp_buffer) ;
                endif ;
	        delete ( now_buffer   ) ;
	        now_buffer :=  tmp_buffer ;
	        max_count  :=  max_count - 1 ;

             endif ;

         else

	     erase ( select_range ) ;
             erase_line ;
             if ( buf_count = max_count )  then
                tmp_buffer  :=  get_info ( buffers,"next") ;
                move_vertical ( - 1 ) ;
                buf_count   :=  max_count - 1 ;
             else   tmp_buffer  :=  get_info ( buffers,"previous") ;
             endif ;

             if ( now_buffer = old_buffer )  then
                message ( "WARNING:  deleting origin-buffer") ;
                old_buffer   :=  tmp_buffer ;
                old_position :=  beginning_of ( tmp_buffer) ;
             endif ;
	        delete ( now_buffer   ) ;
	        now_buffer :=  tmp_buffer ;
	        max_count  :=  max_count - 1 ;

	 endif ;

      else message ( "System buffer:  permission denied." ) ;
      endif ;

   endif ; endif ; endif ; endif ;

   delete ( a_position ) ;

endloop ;

ENDPROCEDURE ;



