PROCEDURE   cjc_buffer_manager

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  procedure to provide a "MACINTOSH-like" buffer manager for EVE
!  functions supported are:
!       view a list of current buffers, with associated status and files
!       return to the buffer of origin           <RETURN>
!       go to the highlighted buffer             <ENTER>
!       go to a prompted-for buffer              <F13>
!       read a prompted-for file into a buffer   <PERIOD>
!       FORTRAN-compile the highlighted buffer   <C>
!       write the highlighted buffer to disk     <W>
!       delete the highlighted buffer            <D>
!       do a DCL command                         <F11>
!       do an EVE command                        <F16>
!       exit to the operating system             <CTRL_Z>
!       move from buffer to buffer               arrow keys
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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 ,
        do_string    ;

ON_ERROR
   message( "ERROR " + str ( ERROR ) + " line " + str ( ERROR_LINE )
                     + "; returning to original buffer " ) ;
   unmap ( info_window ) ;
   map ( old_window , old_buffer ) ;
   position ( old_window ) ;
   eve$position_in_middle ( mark ( NONE ) ) ;
   eve$update_status_lines ;
   return ;
ENDON_ERROR ;


old_position :=  mark ( none )  ;
old_window   :=  current_window ;
old_buffer   :=  current_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 ;

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 ;

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

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

loop
   position ( search ( LINE_BEGIN , REVERSE ) ) ;
   a_position  :=  select ( REVERSE ) ;
   position ( search ( LINE_END , FORWARD ) ) ;
   update   ( info_window ) ;

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

   if ( key_response = CTRL_Z_KEY )  then

      eve_exit

   endif ;

   if ( key_response = RET_KEY )  then

      unmap ( info_window ) ;
      position ( old_window ) ;
      eve$position_in_middle ( old_position ) ;
      eve$update_status_lines ;
      return ;

   endif ;

   if ( key_response = ENTER )  then

      unmap ( info_window ) ;
      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

      unmap ( info_window ) ;
      map ( old_window , eve$dcl_buffer ) ;
      position ( old_window ) ;
      eve$update_status_lines ;
      eve_dcl ( '' ) ;
      return ;

   endif ;

   if ( key_response = F13 )  then

      unmap ( info_window ) ;
      position ( old_window ) ;
      eve_buffer ( '' ) ;
      return ;

   endif ;

   if ( key_response = F16 )  then

       if ( eve$prompt_string (
                             '' ,
                             do_string ,
                             'Command:  ' ,
                             'no command entered' ) ) then

           eve_do ( do_string ) ;

       endif;

   endif ;

   if (  ( key_response = key_name ( 'c' ) )
      or ( key_response = key_name ( 'C' ) ) )  then

      unmap ( info_window ) ;
      map ( old_window , now_buffer ) ;
      position ( old_window ) ;

      if ( cjc_fortran_compile ) then

             delete ( a_position ) ;	!  delete highlighting-select marker
             cjc_buffer_manager ;	!  recursive buffer_manager call

      else
             eve$update_status_lines ;

      endif ;

      return ;

   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

                   ! NOTE -- this still has bugs in it:

                   if ( eve$x_number_of_windows = 2 )  then
                       if (
                               ( get_info ( eve$top_window    , "buffer" )
                                 = old_buffer )
                               and
                               ( get_info ( eve$bottom_window , "buffer" )
                                 = old_buffer )
                          )  then
                           message ( " displaying one window on return" ) ;
                           eve_one_window ;
                           old_window  :=  eve$main_window ;

                       endif ;
                   endif ;

                   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 ;





PROCEDURE   cjc_fortran_compile

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Procedure to FORTRAN-compile the current buffer, and show error-messages
!  in the listing-file in the other editing window (creating one, if it
!  doesn't exist)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   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
         eve$position_in_middle ( 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 ) ;
         eve$position_in_middle ( this_position ) ;
         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' ;

!  check to make sure it's a FORTRAN file (if not, abort):

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

!  if so, invoke the compiler:

   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 ) ;
      cjc_listing_fix ;
      update ( current_window ) ;
      eve_other_window ;
      eve$x_target  :=  'FORT-' ;
      message ( "EVE search target 'FORT-' for additional errors" ) ;

   endif ;

   return ( 0 ) ;

ENDPROCEDURE ;




PROCEDURE cjc_indent_block

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Procedure to indent the current select-range by 4 spaces,
!  being careful to treat FORTRAN-labels, comments, and continuations
!  correctly
!  requires that FORTRAN labels be left-justified to column 1
!  (use CJC_FIX_LABELS below, if necessary, for that)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   start_position ,
        end_position   ,
        now_position   ;

ON_ERROR
	if ( ERROR = TPU$_STRNOTFOUND )  then
            !!!!  do nothing -- needing this section is an idiocy of TPU
            !!!!  made necessary by DEC's design of TPU SEARCH
        else return ;
	endif ;
ENDON_ERROR;

if ( eve$x_select_position = 0 )  then
    message ( 'Mark block to be indented before using block-indent' ) ;
else
    now_position  :=  mark ( NONE ) ;
    if now_position < eve$x_select_position then
        start_position  :=  now_position ;
        end_position    :=  eve$x_select_position ;
    else
        start_position  :=  eve$x_select_position ;
        end_position    :=  now_position ;
    endif ;

    position ( start_position ) ;
    loop
	position ( search ( LINE_BEGIN , reverse ) ) ;
	exitif ( mark ( NONE )  >=  end_position ) ;
        if ( current_character <> 'C' ) and ( current_character <> '*' ) then
            if index ( '0123456789' , current_character ) <> 0  then
                position (
                         end_of (
                                search ( span ( '0123456789' ) , FORWARD )
                                ) ) ;
                move_horizontal ( 1 ) ;
            endif ;
	    copy_text ( '    ' ) ;
        endif ;
        move_vertical ( 1 ) ;
    endloop ;

!   then fix statement-continuations:

    cjc_global_pat_replace (
                           LINE_BEGIN
                               & '         '
                               & ANY ( '&$*#+-1234567890' ) ,
                           '     &    '
                           ) ;

    message ( 'Indentation complete.  Remember to fix line lengths manually' ) ;

endif ;

ENDPROCEDURE ;




PROCEDURE cjc_fix_labels

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  procedure to left-justify FORTRAN labels to column 1
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   target_str   ,
        replace_str  ,
        target_range ,
        col          ,
        now_position ;

ON_ERROR
        if ( ERROR = TPU$_STRNOTFOUND )  then
            !!!!  do nothing -- needing this is an idiocy of TPU courtesy of DEC
        else return ;
        endif ;
ENDON_ERROR;

message ( "Moving all FORTRAN labels to column 1" ) ;

now_position  :=  mark ( NONE ) ;

position (  beginning_of ( current_buffer ) ) ;

loop
        col  :=  1 ;
        loop
            exitif ( get_info ( current_buffer , "character" ) <> ' ' ) ;
            exitif ( get_info ( current_buffer , "offset_column" ) > 5 ) ;
            col  :=  col + 1 ;
            move_horizontal ( 1 ) ;
        endloop ;

        if ( ( get_info ( current_buffer , "offset_column" ) < 6 )
             and ( index ( '1234567890' ,
                           get_info ( current_buffer , "character" )
                         ) <> 0 )
           )  then

            target_range  :=  search ( span ( '1234567890' ) , FORWARD ) ;
            replace_str   :=  erase_character ( length ( target_range ) ) ;
            position ( search ( LINE_BEGIN , REVERSE ) ) ;
            copy_text ( replace_str ) ;

        endif ;

        position ( search ( LINE_BEGIN , REVERSE ) ) ;
        move_vertical ( 1 ) ;

endloop;

eve$position_in_middle ( now_position ) ;

message  ( "FORTRAN labels now fixed" ) ;

ENDPROCEDURE ;





PROCEDURE   cjc_pretty_fortran

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Procedure to put reasonable spacing into "dense" FORTRAN code:
!  adds whitespace around operators, then deletes excess
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!  REPLACEMENT RULES:

    cjc_fix_labels ;

    message ( "adding whitespace around operators" ) ;

    cjc_global_pat_replace ( '('      ,  ' ( '    ) ;
    cjc_global_pat_replace ( ')'      ,  ' ) '    ) ;
    cjc_global_pat_replace ( ','      ,  ' , '    ) ;
    cjc_global_pat_replace ( '+'      ,  '  +  '  ) ;
    cjc_global_pat_replace ( '-'      ,  '  -  '  ) ;
    cjc_global_pat_replace ( '*'      ,  ' * '    ) ;
    cjc_global_pat_replace ( '/'      ,  ' / '    ) ;
    cjc_global_pat_replace ( '='      ,  '  =  '  ) ;
    cjc_global_pat_replace ( '<'      ,  ' < '    ) ;
    cjc_global_pat_replace ( '>'      ,  ' > '    ) ;
    cjc_global_pat_replace ( '.GT.'   ,  ' .GT. ' ) ;
    cjc_global_pat_replace ( '.GE.'   ,  ' .GE. ' ) ;
    cjc_global_pat_replace ( '.LT.'   ,  ' .LT. ' ) ;
    cjc_global_pat_replace ( '.LE.'   ,  ' .LE. ' ) ;
    cjc_global_pat_replace ( '.EQ.'   ,  ' .EQ. ' ) ;
    cjc_global_pat_replace ( '.NE.'   ,  ' .NE. ' ) ;
    cjc_global_pat_replace ( '.OR.'   ,  ' .OR. ' ) ;
    cjc_global_pat_replace ( '.AND.'  ,  ' .AND. ') ;
    cjc_global_pat_replace ( '.NOT.'  ,  ' .NOT. ') ;

!  PATCH-UP RULES (to deal with adjacent applications of the rules above, etc.)

    message ( "fixing up extra whitespace" ) ;
    cjc_global_pat_replace ( '(  ('   ,  '( ('    ) ;
    cjc_global_pat_replace ( ')  )'   ,  ') )'    ) ;
    cjc_global_pat_replace ( '(   '   ,  '(  '    ) ;
    cjc_global_pat_replace ( ')   '   ,  ')  '    ) ;
    cjc_global_pat_replace ( '   )'   ,  '  )'    ) ;
    cjc_global_pat_replace ( '   ('   ,  '  ('    ) ;
    cjc_global_pat_replace ( '   +'      ,  '  +' ) ;
    cjc_global_pat_replace ( '   -'      ,  '  -' ) ;
    cjc_global_pat_replace ( '+   '      ,  '+  ' ) ;
    cjc_global_pat_replace ( '-   '      ,  '-  ' ) ;
    cjc_global_pat_replace ( '-    -'    ,  '--'  ) ;
    cjc_global_pat_replace ( '-    -'    ,  '--'  ) ;
    cjc_global_pat_replace ( '  *'    ,  ' *'     ) ;
    cjc_global_pat_replace ( '*  '    ,  '* '     ) ;
    cjc_global_pat_replace ( '* *'    ,  '**'     ) ;
    cjc_global_pat_replace ( '* *'    ,  '**'     ) ;
    cjc_global_pat_replace ( LINE_BEGIN & ' *'
                                      ,  '*'      ) ;
    cjc_global_pat_replace ( 'CHARACTER * '
                                      , 'CHARACTER*' ) ;
    cjc_global_pat_replace ( 'LOGICAL * '
                                      , 'LOGICAL*') ;
    cjc_global_pat_replace ( 'INTEGER * '
                                      , 'INTEGER*') ;
    cjc_global_pat_replace ( 'REAL * '
                                      ,  'REAL*'  ) ;
    cjc_global_pat_replace ( 'COMPLEX * '
                                      , 'COMPLEX*') ;
    cjc_global_pat_replace ( '.GT.  '  ,  '.GT. ' ) ;
    cjc_global_pat_replace ( '.GE.  '  ,  '.GE. ' ) ;
    cjc_global_pat_replace ( '.LT.  '  ,  '.LT. ' ) ;
    cjc_global_pat_replace ( '.LE.  '  ,  '.LE. ' ) ;
    cjc_global_pat_replace ( '.EQ.  '  ,  '.EQ. ' ) ;
    cjc_global_pat_replace ( '.NE.  '  ,  '.NE. ' ) ;
    cjc_global_pat_replace ( '  .GT.'  ,  ' .GT.' ) ;
    cjc_global_pat_replace ( '  .GE.'  ,  ' .GE.' ) ;
    cjc_global_pat_replace ( '  .LT.'  ,  ' .LT.' ) ;
    cjc_global_pat_replace ( '  .LE.'  ,  ' .LE.' ) ;
    cjc_global_pat_replace ( '  .EQ.'  ,  ' .EQ.' ) ;
    cjc_global_pat_replace ( '  .NE.'  ,  ' .NE.' ) ;
    cjc_global_pat_replace ( '  /'    ,  ' /'     ) ;
    cjc_global_pat_replace ( '/  '    ,  '/ '     ) ;
    cjc_global_pat_replace ( '/ /'    ,  '//'     ) ;
    cjc_global_pat_replace ( '  ,'    ,  ' ,'     ) ;
    cjc_global_pat_replace ( '  ,'    ,  ' ,'     ) ;
    cjc_global_pat_replace ( ',  '    ,  ', '     ) ;
    cjc_global_pat_replace ( ',  '    ,  ', '     ) ;
    cjc_global_pat_replace ( '>   ='  ,  '>='     ) ;
    cjc_global_pat_replace ( '<   ='  ,  '<='     ) ;
    cjc_global_pat_replace ( '   ='   ,  '  ='    ) ;
    cjc_global_pat_replace ( '   ='   ,  '  ='    ) ;
    cjc_global_pat_replace ( '=   '   ,  '=  '    ) ;
    cjc_global_pat_replace ( '=   '   ,  '=  '    ) ;
    cjc_global_pat_replace ( ' / LIST'   ,  '/LIST' ) ;
    cjc_global_pat_replace ( 'PF / MF'   ,  'PF/MF' ) ;

    message ( "pretty_fortran completed " ) ;

ENDPROCEDURE ;



PROCEDURE cjc_global_pat_replace ( target_str , replace_str )

LOCAL 	target_str   ,
	replace_str  ,
	target_range ,
	end_position ,
        now_position ;

ON_ERROR
	if ( ERROR = TPU$_STRNOTFOUND )  then
            !!!!  do nothing -- needing this is an idiocy of TPU courtesy of DEC
        else return ;
	endif ;
ENDON_ERROR;

now_position  :=  mark ( NONE ) ;

if ( eve$x_select_position = 0 )  then
        position (  beginning_of ( current_buffer ) ) ;
        end_position  :=  end_of ( current_buffer ) ;
else
        if now_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
	target_range := search ( target_str, FORWARD ) ;
        exitif ( target_range = 0 ) ;
        exitif ( beginning_of ( target_range ) > end_position ) ;
	erase ( target_range ) ;
	position ( end_of ( target_range ) ) ;
	copy_text ( replace_str ) ;
endloop;

eve$position_in_middle ( now_position ) ;

ENDPROCEDURE ;





PROCEDURE cjc_global_search_replace

LOCAL 	target_str    ,
	replace_str   ,
	target_range  ,
	replace_count ,
        this_position ;

ON_ERROR
        if  ( error = TPU$_STRNOTFOUND )  then
	    message ( fao ( 'Complete !ul replacement!%s', replace_count ) ) ;
        else
            message ( 'Fatal error in global search_and_replace' ) ;
        endif ;
        eve$position_in_middle ( this_position ) ;
        return ;
ENDON_ERROR;

        this_position  :=  mark ( NONE ) ;
	replace_count  := 0;

	eve$prompt_string
			( 	
			"" ,
			target_str ,
			"String to be replaced:  " ,
			"No string entered."
			) ;

	if ( target_str = eve$kt_null ) then  return  endif ;

	eve$prompt_string  ( 	
			"" ,
			replace_str ,
			"String to be replaced:  " ,
			""
			) ;

loop
	target_range := search ( target_str, forward ) ;
	erase ( target_range ) ;
	position ( end_of ( target_range ) ) ;
	copy_text ( replace_str ) ;
	replace_count := replace_count + 1;
endloop;

ENDPROCEDURE ;




PROCEDURE	cjc_multi_search_replace

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   procedure to do multiple-file search and replace, for
!   target-string and replacement-string supplied by the user,
!   in a sequence of files entered from the keyboard by the user.
!   Completion of the list of files is signalled by an empty entry
!   in the list of files.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

ON_ERROR    	!  must deal with DEC TPU's mistaken handling as an error of
		!  SEARCH:  "string not found"

        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  return ( 0 ) ;
            endif ;

	else if ( ERROR <> TPU$_STRNOTFOUND )  then

	    message ( 'FATAL ERROR in substitution-process' ) ;
            map ( this_window , this_buffer ) ;
            position ( this_position ) ;
            return ( 1 ) ;

	endif ; endif ;

ENDON_ERROR ;  	


	if ( 0 = eve$prompt_string (
                                   "" ,
                                   target_str ,
                                   "String to be replaced (RET to quit):  " ,
                                   "No string entered."
                                   ) )  then
            return ;
        endif ;


	eve$prompt_string  ( 	
			"" ,
			replace_str ,
			"String to replace it with:  " ,
			""
		       	) ;

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

	loop

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

               	work_buffer  :=  create_buffer (
                                               work_buf_name ,
                                               input_file
                                               ) ;

                position ( beginning_of ( work_buffer ) ) ;

                set (
                    OUTPUT_FILE ,
                    work_buffer ,
                    input_file
                    ) ;
                replace_count  :=  0 ;

                loop

		    target_range := search ( target_str, forward ) ;
		    exitif ( target_range = 0 ) ;
		    erase  ( target_range ) ;
	       	    position ( end_of ( target_range ) ) ;
		    copy_text ( replace_str ) ;
		    replace_count := replace_count + 1;

                endloop ;

		message ( fao ( 'Complete !ul replacement!%s',
				replace_count ) ) ;

		write_file ( work_buffer ) ;
		delete ( work_buffer ) ;

	endloop ;

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

ENDPROCEDURE ;





PROCEDURE   cjc_indent

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   indent left margin in multiples of  4  , starting at column 9
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   left_marg_indent ;

   left_marg_indent  :=  get_info ( current_buffer , "left_margin" ) ;

   if ( left_marg_indent > 6 )  then
          left_marg_indent  :=  left_marg_indent + 4 ;
   else   left_marg_indent  :=  9 ;
   endif ;

   set (
       MARGINS ,
       CURRENT_BUFFER ,
       left_marg_indent ,
       get_info ( current_buffer , "right_margin" )
       ) ;

   message ( " left margin set at " + str ( left_marg_indent ) ) ;

   return ;

ENDPROCEDURE ;




PROCEDURE   cjc_outdent

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   inverse procedure to cjc_indent
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   left_marg_indent ;

   left_marg_indent  :=  get_info ( current_buffer , "left_margin" ) ;

   if ( left_marg_indent > 9 )  then
          left_marg_indent  :=  left_marg_indent - 4 ;
   else   left_marg_indent  :=  1 ;
   endif ;

   set (
       MARGINS ,
       CURRENT_BUFFER ,
       left_marg_indent ,
       get_info ( current_buffer , "right_margin" )
       ) ;

   message ( " left margin set at " + str ( left_marg_indent ) ) ;

   return ;

ENDPROCEDURE ;




PROCEDURE cjc_toggle_windows

        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        !   Procedure to toggle back and forth between one window and   !
        !   two windows, approximately centering the cursor on the      !
        !   current position in each case                               !
        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL	this_position ;

        this_position  :=  mark ( NONE ) ;

        if ( eve$x_number_of_windows = 1 )  then !  do enhanced eve_two_windows:

             eve$check_bad_window ;
             map ( eve$top_window , current_buffer ) ;
             eve$set_status_line ( eve$top_window ) ;
             position ( eve$top_window ) ;
             eve$position_in_middle ( this_position ) ;
             update ( eve$top_window ) ;

             map ( eve$bottom_window , current_buffer ) ;
             eve$set_status_line ( eve$bottom_window ) ;
             position ( eve$bottom_window ) ;
             eve$position_in_middle ( this_position ) ;
             update ( eve$bottom_window ) ;

             eve$x_number_of_windows  :=  2 ;
             eve$x_this_window  :=  eve$bottom_window ;

        else if ( eve$x_number_of_windows = 2 )  then
             eve_one_window  ;
             eve$position_in_middle ( this_position ) ;
        endif ; endif ;

        eve$update_status_lines ;


ENDPROCEDURE ;



PROCEDURE	cjc_toggle_width

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  TPU procedure to toggle back and forth between the following widths
!  and margins:
!	width   72 , margins  9 --  72
!	width   80 , margins  1 --  88
!	width  132 , margins  1 -- 132
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL	current_width ,
        last_window   ,
        loop_window   ,
        loop_buffer   ;

current_width  :=  get_info ( current_window , "width" ) ;
last_window    :=  get_info ( WINDOWS , EVE$KT_LAST  ) ;
loop_window    :=  get_info ( WINDOWS , EVE$KT_FIRST ) ;

loop
        loop_buffer  :=  get_info ( loop_window , "buffer" ) ;
	if      ( current_width = 72 )  then
	    set ( WIDTH , loop_window , 80 ) ;
	    if ( loop_buffer <> 0 )  then
              set ( MARGINS, loop_buffer , 1 , 88 ) ;
            endif ;
	else if ( current_width = 80 )  then
	    set ( WIDTH , loop_window , 132 ) ;
	    if ( loop_buffer <> 0 )  then
	      set ( MARGINS, loop_buffer , 1 , 132 ) ;
            endif ;
        else if ( current_width = 132 )  then
	    set ( WIDTH , loop_window , 80 ) ;	! resets character-size
       	    set ( WIDTH , loop_window , 72 ) ;
	    if ( loop_buffer <> 0 )  then
              set ( MARGINS, loop_buffer , 9 , 72 ) ;
            endif ;
	endif ; endif ; endif ;

        exitif ( loop_window  =  last_window ) ;
        loop_window  :=  get_info ( windows , "next" ) ;

endloop ;

if      ( current_width = 72 )  then
    message ( "Reset width and margins--WIDTH:  80, MARGINS 1 - 88" ) ;
else if ( current_width = 80 )  then
    message ( "Reset width and margins--WIDTH:  132, MARGINS 1 - 132" ) ;
else if ( current_width = 132 )  then
    message ( "Reset width and margins--WIDTH:  72, MARGINS 9 - 72" ) ;
else
    message ( "Current width = " + str ( current_width ) +
              "; not 72, 80, or 132.  Not reset" )
endif ; endif ; endif ;

return ;

ENDPROCEDURE ;




PROCEDURE   cjc_set_leftmargin_here ;

set ( MARGINS , current_buffer ,
   get_info ( current_window , "current_column" ) ,
   get_info ( current_buffer , "right_margin" ) ) ;

message ( "LEFT MARGIN set to " +
   str ( get_info ( current_window , "current_column" ) ) ) ;

return ;

ENDPROCEDURE;





PROCEDURE cjc_get_current_position

LOCAL   now_position ,
        count ;

   count        :=  1 ;
   now_position :=  mark ( none ) ;
   position ( search ( line_begin, reverse ) ) ;

   loop
      exitif ( mark ( NONE ) =  beginning_of ( current_buffer ) ) ;
      move_vertical ( - 1 )  ;
      count  :=  count + 1 ;
   endloop ;

   position ( now_position ) ;
   message ( "CURRENT POSITION:  line " + str ( count ) +
           ", column "  +  str ( current_column ) ) ;
   return ;

ENDPROCEDURE




PROCEDURE cjc_erase_rest_of_word

LOCAL   pat       ,
        this_buffer    ,
        start_position ,
        end_position   ,
        erase_range    ;

   this_buffer    :=  current_buffer ;
   start_position :=  mark ( NONE )  ;

   if    ( current_window = eve$command_window )
      or ( start_position = end_of ( this_buffer ) )
      or ( index ( eve$x_whitespace, current_character ) <> 0 )
         then return ;
   endif ;

         !  mark end-of-word:

   pat  :=  '' & any ( eve$x_word_separators ) ;
   position ( search ( pat , FORWARD ) ) ;
   if ( search ( ANCHOR & LINE_END , FORWARD ) <> 0 )  then
      move_horizontal ( -1 ) ;
   endif ;
   end_position :=  mark ( NONE ) ;

   erase_range  :=  create_range ( start_position , end_position , NONE ) ;
   position ( start_position ) ;
   eve$x_restore_text   :=  erase_character ( length ( erase_range ) ) ;
   eve$x_restoring_line := 0 ;

ENDPROCEDURE ;



PROCEDURE cjc_erase_rest_of_line

LOCAL   this_buffer ,
        start_position,
        end_position ,
        erase_range ;

   this_buffer    :=  current_buffer ;
   start_position :=  mark ( NONE ) ;

   if    ( current_window = eve$command_window )
      or ( start_position = end_of ( this_buffer ) )
         then return ;
   endif ;

   position ( search ( LINE_END , FORWARD ) ) ;
   end_position :=  mark ( NONE ) ;
   if ( end_position <> start_position )  then
      move_horizontal ( -1 ) ;
      end_position :=  mark ( NONE ) ;
   endif ;

   erase_range  :=  create_range ( start_position , end_position , NONE ) ;
   position ( start_position ) ;
   eve$x_restore_text   :=  erase_character ( length ( erase_range ) ) ;
   eve$x_restoring_line := 0 ;

ENDPROCEDURE ;




PROCEDURE  cjc_erase_entire_line

   eve$x_restoring_line  :=  1 ;
   eve$x_restore_text    :=  erase_line ;

ENDPROCEDURE ;




PROCEDURE cjc_del_pat_lines

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!  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.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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 ;




PROCEDURE	cjc_del_remain

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  TPU procedure to search through the select_range or 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.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL	this_position ,
        end_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
        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 , NONE ) ) ;
        move_vertical ( 1 ) ;
        move_horizontal ( - current_offset ) ;

endloop ;

eve$position_in_middle ( this_position ) ;

ENDPROCEDURE ;




PROCEDURE	cjc_count

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  procedure to count characters, words, and lines in the current buffer
!  Sorry, but the performance is sort of slow -- CJC
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL	c_count ,
	w_count ,
 	l_count ,
	in_word ,
        now_position ,
        end_position ,
	cjc_separators ;

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

cjc_separators  :=  ' 	


' ;

c_count  :=  0 ;
w_count  :=  0 ;
l_count  :=  0 ;

in_word:=  FALSE ;

if ( eve$x_select_position = 0 )  then
        position (  beginning_of ( current_buffer ) ) ;
        end_position  :=  end_of ( current_buffer ) ;
else
        now_position  :=  mark ( NONE ) ;
        if now_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
        now_position  :=  mark ( NONE ) ;

        if ( now_position >=  end_position ) then
            if ( in_word )  then
                w_count  :=  w_count + 1 ;
            endif ;
            if ( now_position = beginning_of (
        			search ( LINE_END , FORWARD ) ) )  then
                l_count  :=  l_count + 1 ;
            endif ;
            exitif ( TRUE ) ;
        endif ;

        if ( now_position = beginning_of (
        			search ( LINE_END , FORWARD ) ) )  then
            if ( in_word )  then
                w_count  :=  w_count + 1 ;
            endif ;
            l_count  :=  l_count + 1 ;
            in_word  :=  FALSE       ;
            position ( search ( LINE_BEGIN , REVERSE ) ) ;
            move_vertical ( 1 ) ;
        else if ( index (
               	        cjc_separators ,
                	current_character )  <>  0  )  then
            if ( in_word )  then
                w_count  :=  w_count + 1 ;
            endif ;
            c_count  :=  c_count + 1 ;
            in_word  :=  FALSE       ;
            move_horizontal ( 1 ) ;
        else
            in_word  :=  TRUE        ;
            c_count  :=  c_count + 1 ;
            move_horizontal ( 1 ) ;
        endif ; endif


endloop ;

message (
	'This buffer/range has  ' +
        str ( l_count )     +  '  lines,  '     +
        str ( w_count )     +  '  words, and  ' +
        str ( c_count )     +  '  characters.'
        ) ;

ENDPROCEDURE ;




PROCEDURE  cjc_detab

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   procedure to replace tabs with spaces, presuming that the current
!   tab settings are in multiples of 8, starting with column 1
!   (i.e., at columns 1, 9, 17, ... )
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   start_position ,
        where ,
        col ,
        end ;

ON_ERROR
        if  ( error <> TPU$_STRNOTFOUND )  then
            eve$position_in_middle ( this_position ) ;
            message ( "Fatal error in detab" ) ;
            return ;
        else
            message ( "DETAB operation completed" ) ;
        endif ;
ENDON_ERROR ;

   start_position  :=  mark ( NONE ) ;

   position ( beginning_of (current_buffer ) ) ;

   loop
      where  :=  search ( ascii ( 9 ) , FORWARD ) ;
      exitif ( where = 0 ) ;
      position ( where ) ;
      col  :=  get_info ( mark ( NONE ) , "offset_column" ) ;
      end  :=  1 ;
      loop
          end  :=  end + 8 ;
          exitif ( end > col ) ;
      endloop ;

      erase ( where ) ;

      loop
         copy_text ( ascii ( 32 ) ) ;
         col  :=  col + 1 ;
         exitif ( col >= end ) ;
      endloop ;

   endloop ;

   eve$position_in_middle ( start_position ) ;

ENDPROCEDURE ;





PROCEDURE eve_fix_crlfs

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  (from DECUS TW Williams TPU stuff):  TPU procedure to replace
!  carriage-return and line-feed characters with TPU-style line-breaks
!  for the entire current buffer.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL	start_position ,
        the_range ;

    ON_ERROR
        if (ERROR <> tpu$_STRNOTFOUND) then
            message("Error (" + str(ERROR) + ") at line " + str(ERROR_LINE));
            eve$position_in_middle ( start_position ) ;
            return ;
        endif;
    ENDON_ERROR;

!
! First remove the CRLFs. If they are not at the EOL, add a line break.
!
    start_position  :=  mark ( NONE ) ;
    position(beginning_of(current_buffer));
    loop
        the_range := search(ascii(13)+ascii(10), FORWARD);
        exitif (the_range = 0);
        erase(the_range);
        position(beginning_of(the_range));
        if (current_character <> "") then
            split_line;
        endif;
    endloop;
!
! Next remove naked LFs. If they are not at the EOL, add a line break.
!
    position(beginning_of(current_buffer));
    loop
        the_range := search(ascii(10), FORWARD);
        exitif (the_range = 0);
        erase(the_range);
        position(beginning_of(the_range));
        if (current_character <> "") then
            split_line;
        endif;
    endloop;
!
! Finally, remove naked CRs. If they are not at the BOL, add a line break.
!
    position(beginning_of(current_buffer));
    loop
        the_range := search(ascii(13), FORWARD);
        exitif (the_range = 0);
        position(end_of(the_range));
        if (current_offset <> 0) then
            split_line;
        endif;
        erase(the_range);
    endloop;

    eve$position_in_middle ( start_position ) ;
    message ( "<CR>s and< LF>s fixed" ) ;

ENDPROCEDURE ;




PROCEDURE cjc_listing_fix

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   procedure to strip the headers off of FORTRAN  *.LIS files so that
!   one can read them more easily in the editor.  Presumes the V4 headers
!   are signalled by a FORMFEED character, and are 4 lines long.
!   Does not act upon non-listing files.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL 	file_name    ,
        target_str   ,
	target_range ,
        now_position ;

ON_ERROR
	if ( ERROR = TPU$_STRNOTFOUND )  then
            !!!!  do nothing -- needing this is an idiocy of TPU courtesy of DEC
        else return ;
	endif ;
ENDON_ERROR;

file_name  :=  get_info ( CURRENT_BUFFER , "FILE_NAME" ) ;
if ( index ( file_parse ( file_name , '' , '' , TYPE ) , 'LIS' ) = 0 ) then
        message ( 'NOT a listing file. No fixing attempted' ) ;
        return ( 0 ) ;
endif ;

target_str    :=  '' ;
now_position  :=  mark ( NONE ) ;
position ( beginning_of ( current_buffer ) ) ;

loop
	target_range := search ( target_str, FORWARD ) ;
        exitif ( target_range = 0 ) ;
        position ( beginning_of ( target_range ) ) ;

        erase_line ;  erase_line ;
        erase_line ;  erase_line ;
endloop;

position ( now_position ) ;
message  ( 'LISTING fixed -- page headers deleted' ) ;

ENDPROCEDURE ;




PROCEDURE       cjc_matchit

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Generalized parenthesis matcher -- find the nearest paren, brace, or
!  bracket in the current direction; find the matching symbol in the
!  appropriate direction, and place the cursor upon that matching symbol.
!  Reports error-messages in the cases of no such symbol in the current
!  direction, and of no matching symbol
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   now   ,            !  current location-marker
        go    , where ,    !  current-direction, matching-search direction
        start , finish ,   !  position of starting, matching symbol
        got   , want ,     !  opening , closing symbol
        pat   ,            !  matching-symbol search-pattern
        nest  ;            !  current symbol-nest level

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

ENDON_ERROR ;

   now   :=  mark ( NONE ) ;
   go    :=  current_direction ;
   start :=  search ( "" & any ( "()[]{}") , go ) ;
   if  ( start = 0 )  then
      message ("Not found; nothing to match in that direction");
      return
   endif;

   position ( start ) ;
   got  :=  current_character ;

   if      ( got  =  "(" )  then
      want  :=  ")" ;
      where :=  FORWARD
   else if ( got  =  ")" )  then
      want  :=  "(" ;
      where :=  REVERSE
   else if ( got  =  "[" )  then
      want  :=  "]" ;
      where :=  FORWARD
   else if ( got  =  "]" )  then
      want  :=  "[" ;
      where :=  REVERSE
   else if ( got  =  "{" )  then
      want  :=  "}" ;
      where :=  FORWARD
   else
      want  :=  "{" ;
      where :=  REVERSE
   endif   endif   endif   endif   endif ;

   nest  :=  1 ;
   now   :=  mark ( NONE ) ;
   pat   :=  ( "" & ( got | want ) ) ;

   loop
      if ( where = FORWARD )  then
             move_horizontal (   1 ) ;
      else   move_horizontal ( - 1 ) ;
      endif ;

      finish  :=  search ( pat , where , EXACT ) ;
      if   ( finish  =  0 )  then
         message ( "Could not match " ) ;
         eve$position_in_middle ( now ) ;
         set ( go , current_buffer ) ;
         return ;
      endif ;

      position ( finish ) ;

      if  ( current_character  =  got )  then
             nest  :=  nest + 1
      else   nest  :=  nest - 1
      endif ;

      exitif  ( nest = 0 ) ;

   endloop ;

   eve$position_in_middle ( finish ) ;
   set ( go , current_buffer ) ;

   return ;

ENDPROCEDURE ;




PROCEDURE        cjc_pre_fill

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   insert a user-supplied prefill-string at the beginning of every line
!   of either the currently-active select-range or the rest of the buffer.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   pre_fill_string ,
        now_position    ,
        end_position    ;

ON_ERROR
	if ( ERROR = TPU$_STRNOTFOUND )  then
            !!!!  do nothing -- needing this is an idiocy of TPU courtesy of DEC
        else
             message ( 'Fatal error in PREFILL -- returning to user' ) ;
             eve$position_in_middle ( now_position ) ;
             return ;
	endif ;
ENDON_ERROR;

if  (eve$prompt_string ( ''  ,
        pre_fill_string  ,
        "Enter string to be inserted:  " ,
        "no string entered; no insertion performed" ) )  then

      now_position  :=  mark ( NONE ) ;

      if ( eve$x_select_position = 0 )  then
              end_position  :=  end_of ( current_buffer ) ;
      else
              if now_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
             position ( search ( line_begin , reverse ) ) ;
             exitif ( mark ( NONE )  >=  end_position ) ;
             copy_text ( pre_fill_string ) ;
             move_vertical ( 1 ) ;

      endloop ;

endif ;

eve$position_in_middle ( now_position ) ;

return ;

ENDPROCEDURE ;





PROCEDURE   cjc_post_fill

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   insert a user-supplied postfill-string at the end of every line
!   of either the currently-active select-range or the rest of the buffer.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   post_fill_string ,
        now_position     ,
        end_position     ;

ON_ERROR
	if ( ERROR = TPU$_STRNOTFOUND )  then
            !!!!  do nothing -- needing this is an idiocy of TPU courtesy of DEC
        else
             message ( 'Fatal error in POSTFILL -- returning to user' ) ;
             eve$position_in_middle ( now_position ) ;
             return ;
	endif ;
ENDON_ERROR;

if  (eve$prompt_string ( ''  ,
        post_fill_string  ,
        "Enter string to be inserted:  " ,
        "no string entered; no insertion performed" ) )   then

      now_position  :=  mark ( NONE ) ;

      if ( eve$x_select_position = 0 )  then
              end_position  :=  end_of ( current_buffer ) ;
      else
              if now_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
             position ( search ( LINE_END , FORWARD ) ) ;
             exitif ( mark ( NONE ) >=  end_position ) ;
             copy_text ( post_fill_string ) ;
             move_vertical ( 1 ) ;
             position ( search ( LINE_BEGIN , REVERSE ) ) ;

      endloop ;

endif ;

eve$position_in_middle ( now_position ) ;

return ;

ENDPROCEDURE ;





PROCEDURE tww_eve_display_character

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This procedure writes a one line message describing the current character
! in terms of Octal, Decimal, Hexadecimal and (sometimes) '^' notation.
!	--from DECUS submission by T. W. WILLIAMS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  LOCAL	i    ,
	cc   ,
	reps ,
	rep  ;

  REPS := "0<NUL>1<SOH>2<STX>3<ETX>4<EOT>5<ENQ>6<ACK>7<BEL>"
        + "8<BS>9<HT>10<LF>11<VT>12<FF>13<CR>14<SO>15<SI>"
        + "16<DLE>17<DC1>18<DC2>19<DC3>20<DC4>21<NAK>22<SYN>23<ETB>"
        + "24<CAN>25<EM>26<SUB>27<ESC>28<FS>29<GS>30<RS>31<US>"
        + "32<SP>127<DEL>132<IND>133<NEL>134<SSA>135<ESA>136<HTS>"
        + "137<HTJ>138<VTS>139<PLD>140<PLU>141<RI>142<SS2>143<SS3>"
        + "144<DCS>145<PU1>146<PU2>147<STS>148<CCH>149<MW>150<SPA>"
        + "151<EPA>155<CSI>156<ST>157<OSC>158<PM>159<APC>";

  ! Handle end-of-buffer condition
  IF MARK( NONE ) = END_OF( CURRENT_BUFFER ) THEN
    MESSAGE( 'At end of buffer, no current character.' );
    RETURN;
  ENDIF;

  ! Convert the character to an integer the hard way (no builtin yet)

  i := 0 ;
  LOOP;
    EXITIF i > 255;
    EXITIF CURRENT_CHARACTER = ASCII(i);
    i := i + 1;
  ENDLOOP;

  IF i > 255 THEN i := 0; ENDIF; ! On overflow, reset to NULL

  ! Provide ^ notation for ASCII control characters
  IF i < 32
    THEN cc := ', ^' + ASCII(i+64);
    ELSE cc := '';
  ENDIF;

  ! Provide mnemonic representation, too.
  IF (  I <= 32) OR  ( I = 127)  OR
     (( I > 131) AND ( I < 152)) OR
     (( I > 154) AND ( I < 160))
  THEN
     REP := SUBSTR( REPS,
                    INDEX( REPS, STR( I)) + LENGTH( STR( I)),
                    5);
     IF SUBSTR( REP, 5, 1) <> ">"
     THEN
        REP := SUBSTR( REP, 1, 4);
     ENDIF;
  ELSE
     REP := CURRENT_CHARACTER;
  ENDIF;

  ! Format and output the results
  MESSAGE( FAO( "Current Character is '!AS', Decimal=!UB, " +
                "Hex=!-!XB, Octal=!-!OB!AS", REP, i, cc ) );

ENDPROCEDURE; ! eve_display_character




PROCEDURE  hex_to_dec

LOCAL	the_num ,
	a_digit ,
	d_index ,
	hex_str ,
        spa_str ,
        dec_str ,
        dig_str ,
        atf_str ;

if ( eve$prompt_string ( "" ,
		hex_str ,
		"Enter hex number:  " ,
   		"No number entered" ) )
then
       	the_num  :=  0 ;
        d_index  :=  1 ;
        spa_str  :=  ' 	
' ;
        atf_str  :=  'abcdefABCDEF' ;
        dec_str  :=  '0123456789'   ;
        dig_str  :=  dec_str + atf_str ;

        loop
            a_digit  :=  substr ( hex_str , d_index , 1 ) ;
            exitif ( index ( spa_str , a_digit ) = 0 ) ;
            d_index  :=  d_index + 1 ;
        endloop ;

        loop
            exitif ( d_index > length ( hex_str ) ) ;
            a_digit  :=  substr ( hex_str , d_index , 1 ) ;
            exitif ( index ( spa_str , a_digit ) <> 0 ) ;

            if ( index ( dig_str , a_digit ) = 0 ) then
                message (
                	'Illegal character ' + a_digit +
                	' in string ' + hex_str +
                	'; current value:  ' + ascii ( the_num )
                	) ;
                return ;
            else if ( index ( dec_str , a_digit ) <> 0 )  then
                the_num  :=  16 * the_num  +  int ( a_digit ) ;
            else if  ( ( a_digit = 'a' ) or ( a_digit = 'A' ) )  then
                the_num  :=  16 * the_num  +  10 ;
            else if  ( ( a_digit = 'b' ) or ( a_digit = 'B' ) )  then
                the_num  :=  16 * the_num  +  11 ;
            else if  ( ( a_digit = 'c' ) or ( a_digit = 'C' ) )  then
                the_num  :=  16 * the_num  +  12 ;
            else if  ( ( a_digit = 'd' ) or ( a_digit = 'D' ) )  then
                the_num  :=  16 * the_num  +  13 ;
            else if  ( ( a_digit = 'e' ) or ( a_digit = 'E' ) )  then
                the_num  :=  16 * the_num  +  14 ;
            else if  ( ( a_digit = 'f' ) or ( a_digit = 'F' ) )  then
                the_num  :=  16 * the_num  +  15 ;
            endif ; endif ; endif ; endif ; endif ; endif ; endif ; endif ;
            d_index  :=  d_index + 1 ;
        endloop ;

        message (
        	'HEX ( '     + hex_str          + ' )  ==  ' +
        	'DECIMAL ( ' + str ( the_num )  + ' )'
        	) ;

endif ;

return ;

ENDPROCEDURE ;





PROCEDURE  dec_to_hex

LOCAL	the_num ,
	a_digit ,
	a_place ,
	d_index ,
	hex_str ,
        dec_str ;

if ( eve$prompt_string ( "" ,
	   	dec_str ,
		"Enter decimal number:  " ,
		"No number entered" ) )
then
        hex_str  :=  '' ;
        the_num  :=  int ( dec_str ) ;

        loop

            exitif ( the_num = 0 ) ;
            a_place  :=  the_num  -  16 * ( the_num / 16 ) ;
            if ( a_place < 10 )  then  a_digit  :=  str ( a_place )
             else if ( a_place = 10 )  then  a_digit  :=  'A'
             else if ( a_place = 11 )  then  a_digit  :=  'B'
             else if ( a_place = 12 )  then  a_digit  :=  'C'
             else if ( a_place = 13 )  then  a_digit  :=  'D'
             else if ( a_place = 14 )  then  a_digit  :=  'E'
             else if ( a_place = 15 )  then  a_digit  :=  'F'
            endif ; endif ; endif ; endif ; endif ; endif ; endif ;

            hex_str  :=  a_digit + hex_str ;
            the_num  :=  the_num / 16 ;

        endloop ;

        if ( length ( hex_str ) = 0 )  then  hex_str := '0'  endif ;

        message (
        	'DECIMAL ( ' + dec_str + ' ) == ' +
                'HEX ( '     + hex_str + ' ) '
                ) ;

endif ;

return ;

ENDPROCEDURE ;





PROCEDURE   cjc_get_filelist

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   puts a column list of files satisfying a user-supplied file-spec
!   into the DCL buffer.  Strips off version-numbers, etc, and only
!   reports the highest version, so that output is ready for cut-and-paste
!   to create .COM files and the like.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LOCAL   dir_spec_str ,
        semi_range   ,
        now_loc      ,
        top_loc      ,
        end_loc      ;

ON_ERROR
	if ( ERROR = TPU$_STRNOTFOUND )  then
            !!!!  do nothing -- needing this is an idiocy of TPU courtesy of DEC
        else
             message ( 'Fatal error in PREFILL -- returning to user' ) ;
             eve$position_in_middle ( now_loc ) ;
             return ;
	endif ;
ENDON_ERROR;

now_loc  :=  mark ( NONE ) ;

eve$prompt_string
   (
   '' ,
   dir_spec_str ,
   "Enter file-spec:  " ,
   "No file-spec entered; listing all files in current directory."
   ) ;

eve_dcl ( "dir/noheader/notrailer/versions=1 " + dir_spec_str ) ;

eve_other_window ;


position ( search ( "dir" , REVERSE , EXACT ) ) ;
top_loc  :=  mark ( NONE ) ;

loop
   semi_range  :=  search ( ';' , FORWARD ) ;
   exitif ( semi_range = 0 ) ;
   position ( semi_range ) ;
   position ( search ( LINE_END , FORWARD ) ) ;
   move_horizontal ( -1 ) ;
   end_loc  :=  mark ( NONE ) ;
   erase ( create_range ( beginning_of ( semi_range ) , end_loc , NONE ) ) ;
endloop ;

eve$position_in_middle ( top_loc ) ;

return ;

ENDPROCEDURE ;




PROCEDURE   cjc_insert_date

LOCAL   day , month , year ;

copy_text(fao("!%D",0));   ! copy current system date & time to buffer
erase_character ( - 12 ) ;
year  :=  erase_character ( - 4 ) ;
erase_character ( - 1 ) ;
month :=  erase_character ( - 3 ) ;
erase_character ( - 1 ) ;
day   :=  erase_character ( - 2 ) ;
eve$capitalize_string ( month ) ;
copy_text ( month + '. ' + day + ', ' + year )

ENDPROCEDURE ;




!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!   Construct template for DO-loop
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

PROCEDURE  cjc_do_loop

LOCAL   acol   ,
        margin ,
        label  ,
        counter,
        lo , hi;

        margin  :=  get_info ( CURRENT_BUFFER , "LEFT_MARGIN" ) ;
        if ( margin < 7 ) then
            cjc_indent ;
            margin  :=  get_info ( CURRENT_BUFFER , "LEFT_MARGIN" ) ;
        endif ;

        eve_return ;
        copy_text ( "DO  " ) ;
        if eve$prompt_string (
                             "" ,
                             label ,
                             "Enter LABEL to bound DO-loop >>> " ,
                             "No label entered"
                             )  then
            copy_text ( label ) ;
        endif ;

        copy_text ( "  " ) ;
        if eve$prompt_string (
                             "" ,
                             counter ,
                             "Enter name of COUNTER variable >>> " ,
                             "No counter entered"
                             )  then
            change_case ( counter , UPPER ) ;
            copy_text   ( counter + " = " ) ;
        endif ;

        if eve$prompt_string (
                             "" ,
                             lo ,
                             "Enter STARTING VALUE for DO-loop >>> " ,
                             "No value entered"
                             )  then
            change_case ( lo , UPPER ) ;
            copy_text   ( lo + " , ") ;
        endif ;

        if eve$prompt_string (
                             "" ,
                             hi ,
                             "Enter ENDING VALUE for DO-loop >>> " ,
                             "No value entered"
                             )  then
            change_case ( hi , UPPER ) ;
            copy_text   ( hi ) ;
        endif ;

        split_line ;
        copy_text ( label ) ;
        acol    :=  get_info ( CURRENT_BUFFER , "OFFSET_COLUMN" ) ;
        loop
            exitif ( acol >= margin ) ;
            copy_text ( " " ) ;
            acol  :=  acol + 1 ;

        endloop ;

        copy_text ( "CONTINUE" ) ;
        eve_return ;
        position ( search ( LINE_BEGIN , REVERSE ) ) ;
        move_vertical ( - 2 ) ;
        position ( search ( LINE_END , FORWARD ) ) ;

        cjc_indent ;

        eve_return ;
        eve$position_in_middle ( mark ( NONE ) ) ;


ENDPROCEDURE ;




!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!   Construct template for IF-THEN-ELSE block
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

PROCEDURE  cjc_if_block

LOCAL   acol      ,
        margin    ,
        condition ,
        start_mk  ,
        flag      ;

        margin  :=  get_info ( CURRENT_BUFFER , "LEFT_MARGIN" ) ;
        if ( margin < 7 ) then
            cjc_indent ;
            margin  :=  get_info ( CURRENT_BUFFER , "LEFT_MARGIN" ) ;
        endif ;
        eve_return ;

        copy_text ( "IF  ( " ) ;
        if eve$prompt_string (
                             "" ,
                             condition ,
                             "Enter CONDITION for IF-block >>> " ,
                             "No condition entered"
                             )  then
            copy_text ( condition ) ;
        endif ;
        copy_text ( " )  THEN" ) ;

        cjc_indent  ;
        eve_return  ;
        start_mk  :=  mark ( NONE ) ;
        move_horizontal ( 1 ) ;

        loop
            cjc_outdent ;
            exitif ( NOT eve$prompt_string (
                             "" ,
                             condition ,
                             "ELSEIF condition [<RET> omit] >>> " ,
                             "" )
                     ) ;

            eve_return ;
            copy_text ( "ELSE IF  ( " + condition + " )  THEN" ) ;
            cjc_indent  ;
            eve_return  ;


        endloop ;

        if ( eve$insist_y_n ( "ELSE clause ? (Y/N) " ) ) then
            eve_return  ;
            copy_text ( "ELSE" ) ;
            cjc_indent  ;
            eve_return  ;
            cjc_outdent ;
        endif ;

        eve_return ;
        copy_text ( "ENDIF" ) ;
        eve_return ;

        cjc_indent  ;
        eve$position_in_middle ( start_mk) ;

        return ;

ENDPROCEDURE ;





PROCEDURE  cjc_fortran_cont

LOCAL    topcnt , count ;

    split_line ;
    copy_text ( "     &          " ) ;

    count  :=  9 ;
    topcnt :=  get_info ( CURRENT_BUFFER , "LEFT_MARGIN" ) ;

    loop
        exitif ( count >= topcnt ) ;
        copy_text ( ' ' ) ;
        count  :=  count + 1

    endloop ;

ENDPROCEDURE;





PROCEDURE  cjc_fortran_comment

LOCAL    topcnt , count ;

    split_line ;
    copy_text ( "C......." ) ;
    count  :=  9 ;
    topcnt :=  get_info ( CURRENT_BUFFER , "LEFT_MARGIN" ) ;

    loop
        exitif ( count >= topcnt ) ;
        copy_text ( '.' ) ;
        count  :=  count + 1

    endloop ;

    copy_text ( '   ' ) ;

ENDPROCEDURE;





PROCEDURE   cjc_find_fortran_label

LOCAL   pat ,
        where ;

ON_ERROR

   message ( "NO MORE LABELS in the current direction" ) ;

ENDON_ERROR ;

	pat  :=   ( LINE_BEGIN &
			(           any ( '0123456789' )
			| ( ' ' &   any ( '0123456789' ) )
			| ( '  ' &  any ( '0123456789' ) )
			| ( '   ' & any ( '0123456789' ) )
   			) ) ;

	if ( mark ( NONE ) = beginning_of ( search ( LINE_BEGIN , REVERSE ) ) )
 		then
		if ( current_direction = FORWARD )  then
			  move_vertical (  1 ) ;
		else move_vertical ( -1 ) ;
		endif ;
	endif ;
	eve$position_in_middle ( search ( pat , CURRENT_DIRECTION ) ) ;

ENDPROCEDURE ;





PROCEDURE  cjc_top_move ;

   cursor_vertical ( get_info ( current_window , "visible_top" )
                   - get_info ( current_window , "current_row" ) ) ;

ENDPROCEDURE;



PROCEDURE     cjc_bottom_move ;

   cursor_vertical ( get_info ( current_window , "visible_bottom" )
                   - get_info ( current_window , "current_row" ) ) ;

ENDPROCEDURE;



PROCEDURE  cjc_middle_move ;

   cursor_vertical ( ( get_info ( current_window , "visible_bottom" )
                     + get_info ( current_window , "visible_top" ) ) / 2
                     - get_info ( current_window , "current_row" ) ) ;

ENDPROCEDURE;





PROCEDURE  cjc_jump_vertical

LOCAL   total ;

   if  eve$prompt_number ( "" , total ,
            "Enter number of lines to jump:  " ,
            "No response given. "
            )   then
      move_vertical ( total ) ;
      eve$position_in_middle ( mark ( NONE ) ) ;
   endif ;

ENDPROCEDURE ;




PROCEDURE cjc_write_whatever ;

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!	If the select-range is active, write it;
!	else write the current buffer
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

if ( eve$x_select_position = 0 )  then eve_write_file ( "" ) ;
else write_file ( select_range ) ;
endif ;

ENDPROCEDURE ;




PROCEDURE   cjc_uppercase_words

LOCAL   now_position   ,
        start_position ,
        end_position   ;

if ( eve$x_select_position = 0 )  then

        eve_uppercase_word ;

else
        now_position  :=  mark ( NONE ) ;
        if eve$x_select_position < now_position  then
            start_position  :=  eve$x_select_position ;
            end_position    :=  now_position ;
        else
            end_position    :=  eve$x_select_position ;
            start_position  :=  now_position ;
        endif ;

        position ( start_position ) ;

        loop
            exitif ( mark ( NONE ) >= end_position ) ;
            eve_uppercase_word ;
        endloop ;

endif ;

ENDPROCEDURE ;





PROCEDURE   cjc_lowercase_words

LOCAL   now_position   ,
        start_position ,
        end_position   ;

if ( eve$x_select_position = 0 )  then

        eve_lowercase_word ;

else
        now_position  :=  mark ( NONE ) ;
        if eve$x_select_position < now_position  then
            start_position  :=  eve$x_select_position ;
            end_position    :=  now_position ;
        else
            end_position    :=  eve$x_select_position ;
            start_position  :=  now_position ;
        endif ;

        position ( start_position ) ;

        loop
            exitif ( mark ( NONE ) >= end_position ) ;
            eve_lowercase_word ;
        endloop ;

endif ;

ENDPROCEDURE ;





PROCEDURE   cjc_capitalize_words

LOCAL   now_position   ,
        start_position ,
        end_position   ;

if ( eve$x_select_position = 0 )  then

        eve_capitalize_word ;

else
        now_position  :=  mark ( NONE ) ;
        if eve$x_select_position < now_position  then
            start_position  :=  eve$x_select_position ;
            end_position    :=  now_position ;
        else
            end_position    :=  eve$x_select_position ;
            start_position  :=  now_position ;
        endif ;

        position ( start_position ) ;

        loop
            exitif ( mark ( NONE ) >= end_position ) ;
            eve_capitalize_word ;
        endloop ;

endif ;

ENDPROCEDURE ;





PROCEDURE   cjc_dcl

LOCAL	this_position ;

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Clear the message window, and save the current position.
!  Then do eve_dcl with empty argument-string -- prompts the user
!  for a DCL command.
!  Finally, restore the current position -- centered, and
!  give completion message.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

        message('') ;
        this_position  :=  mark ( NONE ) ;
        eve_dcl('') ;
        eve$position_in_middle ( this_position ) ;
        message ('DCL command completed') ;

ENDPROCEDURE ;





PROCEDURE    cjc_keydefs;

define_key ( "cjc_lowercase_words" ,
           F7 ,
           "lower case of current word" ) ;

define_key ( "cjc_uppercase_words" ,
           F8 ,
           "UPCASE current word" ) ;

define_key ( "cjc_capitalize_words" ,
           F9 ,
           "Capitalize current word" ) ;

define_key ( "cjc_toggle_width" ,
           F10 ,
           "toggle width and margins " ) ;

define_key ( " cjc_dcl" ,
           F11 ,
           "do a DCL command" ) ;

define_key ( "eve_include_file( '' ); eve$position_in_middle( mark( NONE )) " ,
           F12 ,
           "include a file at the current position" ) ;

define_key ( "eve_buffer( '' ) ; eve$position_in_middle ( mark ( NONE ) ) " ,
           F13 ,
           "change buffer " ) ;

define_key ( "cjc_toggle_windows" ,
           F18 ,
           " toggle:  one window / two windows" ) ;

define_key ( "eve_fill_paragraph; eve$position_in_middle ( mark ( NONE ) );" ,
           F19 ,
           " paragraph fill " ) ;

define_key ( "cjc_buffer_manager" ,
           F20 ,
           "buffer manager" ) ;	!  examine buffer status, change buffers,
            			!  write and delete buffers

define_key ( "cjc_top_move" ,
           key_name ( UP , SHIFT_KEY ) ,
           "go to  top-of-window" ) ;

define_key ( "cjc_bottom_move" ,
           key_name ( DOWN , SHIFT_KEY ) ,
           "go to  bottom-of-window" )  ;

define_key ( "cjc_jump_vertical" ,
           key_name ( RET_KEY , SHIFT_KEY ) ,
           "vertical jump < NUMBER OF LINES >" ) ;

define_key ( "message ( 'Use arrow keys to stop scroll safely' ) ; "
             + "scroll ( current_window ) " ,
           key_name ( E6 , SHIFT_KEY ) ,
           "continuous scroll" ) ;
                  			!  in current direction

define_key ( "eve_line( '' )",
           PF4 ,
           "go to < LINE >" ) ;

define_key ( "cjc_set_leftmargin_here" ,
           KP3 ,
           "set left margin at current cursor location" ) ;

define_key ( "cjc_del_pat_lines" ,
           key_name ( KP6 , SHIFT_KEY ) ,
           "multifile delete lines with a pattern" ) ;

define_key ( "cjc_del_remain" ,
           key_name ( MINUS , SHIFT_KEY ) ,
           "delete remainder-of-lines after pattern" ) ;

define_key ( "cjc_global_search_replace" ,
           key_name ( KP7 , SHIFT_KEY ) ,
           "search-and-replace for current_buffer" ) ;

define_key ( "cjc_multi_search_replace" ,
           key_name ( KP8 , SHIFT_KEY ) ,
           "multi-file search-and-replace" ) ;

define_key ( "cjc_pretty_fortran" ,
           key_name ( KP9 , SHIFT_KEY ) ,
           "space FORTRAN operators for current_buffer" ) ;

define_key ( "cjc_detab ; message ( 'DETAB operation completed' ) ; " ,
           key_name ( TAB_KEY , SHIFT_KEY ) ,
           "replace tabs with spaces" ) ;

define_key ( "eve_fix_crlfs ; message ( 'CRs and LFs fixed' ) ; " ,
           key_name ( ENTER , SHIFT_KEY ) ,
           "replace CRLFs , CRs, and LFs with TPU line-breaks" ) ;

define_key ( "cjc_find_fortran_label" ,	
           key_name ( E1 , SHIFT_KEY ) ,
           "find next FORTRAN label" ) ;

define_key (
"copy_text ( ascii ( int ( read_line ( 'Decimal value of character:  '))))" ,
           key_name ( 'A' , SHIFT_KEY ) ,
           "insert ASCII character" ) ;

define_key ( "tww_eve_display_character" ,
           key_name ( 'B' , SHIFT_KEY ) ,
           "display character as octal, hex, decimal, control" ) ;

define_key ( "cjc_fortran_compile" ,
           key_name ( 'C' , SHIFT_KEY ) ,
           "FORTRAN-compile current buffer" ) ;

define_key ( "cjc_insert_date" ,
           key_name ( 'D' , SHIFT_KEY ) ,
           "insert today's date" ) ;

define_key ( "cjc_do_loop" ,
           key_name ( CTRL_D_KEY , SHIFT_KEY ) ,
           "construct FORTRAN DO loop ") ;

define_key ( "cjc_get_filelist" ,
           key_name ( 'F' , SHIFT_KEY ) ,
           "File-list in DCL-buffer" ) ;   	!  get list of files,
      			!  one-per-line, with directory-spec prepended

define_key ( "cjc_if_block" ,
           key_name ( CTRL_F_KEY , SHIFT_KEY ) ,
           "construct FORTRAN IF-block" ) ;

define_key ( "dec_to_hex" ,
           key_name ( 'G' , SHIFT_KEY ) ,
           "decimal-to-hex conversion" ) ;

define_key ( "hex_to_dec" ,
           key_name ( 'H' , SHIFT_KEY ) ,
           "hex-to-decimal conversion" ) ;

define_key ( "cjc_pre_fill" ,
           key_name ( 'I' , SHIFT_KEY ) ,
           "pre-fill" ) ;   			!  prompt for text and insert
      			!  it at beginning of lines, throughought rest of buffer

define_key ( "cjc_post_fill" ,
           key_name ( 'J' , SHIFT_KEY ) ,
           "post-fill" ) ;   			!  prompt for text and insert
      			!  it at end of lines, throughought rest of buffer

define_key ( "change_case ( search ( remain , FORWARD ) , UPPER )" ,
           key_name ( 'L' , SHIFT_KEY ) ,
           "UPCASE rest-of-line" ) ;

define_key ( "cjc_middle_move" ,
           key_name ( 'M' , SHIFT_KEY ) ,
           "go to  middle-of-window" ) ;

define_key ( " cjc_indent_block " ,
           key_name ( 'N' , SHIFT_KEY ) ,
           "Indent select-range" ) ;

define_key ( " cjc_write_whatever " ,
           key_name ( 'O' , SHIFT_KEY ) ,
           "write current buffer to file" ) ;

define_key ( "cjc_get_current_position" ,
           key_name ( 'P' , SHIFT_KEY ) ,
           "get current col, line numbers" ) ;

define_key ( "message ( 'TPU compiling...' ) ; "
             +  "set ( INFORMATIONAL , ON )  ; "
             +  "compile ( current_buffer )  ; "
             +  "set ( INFORMATIONAL , OFF)  ; " ,
           key_name ( 'T' , SHIFT_KEY ) ,
           "TPU-compile current buffer" ) ;

define_key (
" eve$trim_buffer ( current_buffer ) ; message( 'TRIM complete' ) ; " ,
           key_name ( CTRL_T_KEY, SHIFT_KEY ) ,
           " TRIM current buffer" ) ;

define_key ( "cjc_count " ,
           key_name ( 'W' , SHIFT_KEY ) ,
           "do line , word , char count" ) ;

define_key ( "cjc_matchit" ,
           CTRL_P_KEY ,
           "match parens, braces, brackets" ) ;

define_key ( "cjc_fortran_cont" ,
           CTRL_K_KEY ,
           "generate  FORTRAN  continuation" ) ;

define_key ( "cjc_fortran_comment" ,
           CTRL_A_KEY ,
           "generate  FORTRAN  comment" ) ;

define_key ( "change_case ( search ( remain , FORWARD ) , LOWER )" ,
           CTRL_L_KEY ,
           "downcase REST-OF-LINE" ) ;

define_key ( "cjc_listing_fix " ,
           key_name ( CTRL_L_KEY , SHIFT_KEY ) ,
           "remove headers from listing files" ) ;

define_key ( "cjc_erase_entire_line" ,
           CTRL_G_KEY ,
           "erase entire line" ) ;

define_key ( "eve_change_mode ; message ( 'changing INSERT/OVERSTRIKE' ) ; " ,
           CTRL_T_KEY ,
           "change insert/overwrite mode" ) ;

define_key ( "cjc_indent" ,
           CTRL_N_KEY ,
           "auto-indent (CTRL-J is outdent)" ) ;

define_key ( "cjc_outdent" ,
           CTRL_J_KEY ,
           "auto-outdent (CTRL-N is indent" ) ;

define_key ( "cjc_erase_rest_of_line" ,
           CTRL_D_KEY ,
           "erase rest-of-line" ) ;     !  erase rest of line (no line joins)

define_key ( "cjc_erase_rest_of_word" ,
           CTRL_F_KEY ,		 	!  erase rest of word
           "erase rest of word" ) ;	!  (no whitespace, no line joins )


ENDPROCEDURE ;



PROCEDURE  tpu$local_init

   set ( SHIFT_KEY , F14 ) ;
   set ( INSERT , eve$command_buffer ) ;
   set ( MARGINS , current_buffer , 1 , 88 ) ;
   eve$x_default_right_margin  :=  - 4 ;
   eve$x_trimming  :=  TRUE ;
   if get_info ( SCREEN , "vt200" )  then
      cjc_keydefs ;
   endif ;

ENDPROCEDURE ;