PROCEDURE    	cjc_matchit

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  TPU procedure to match PARENS, BRACES, AND BRACKETS:
!  go in the current direction to the first paren, brace, or bracket
!  encountered ; then go in the appropriate direction , allowing for nesting,
!  until the matching symbol(if any) is found.
!  If not found, report the error on the message-window.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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	!  Deal with DEC TPU's defective SEARCH command which
ENDON_ERROR ;	!  gives "string not found" as an error condition.

	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 ;