!++
! FILENAME: MATCHING.TPU
! FUNCTION: This file contains procedures for finding and manipulating matching
!           strings.
! AUTHOR:   Steven K. Shapiro, (C) Copyright SKS Enterprises, Austin TX.
!                                  All Rights Reserved.
!
!           The format, structure and contents of this file are the sole
!           property  of Steven K. Shapiro  and are  copyrighted to  SKS
!           Enterprises, Austin Texas.
!
!           The information may be freely distributed, used and modified
!           provided  that the  information in this  header block is not
!           changed, altered, disturbed or modified in any way.
!
! DATE:     26-AUG-1987 Original.
! HISTORY:  current.
! CONTENTS:
!           eve_find_matching
!           evedt_match (match_chars, quote_chars)
!           evedt_display_line
!           eve_set_matching(the_arg)
!           eve_set_nomatching(the_arg)
!           evedt_insert_matched
!           eve_find_be_match
!
!23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H
!--
!*----------------------------------------------------------------------------*!

procedure matching_module_ident 

  local file_date,
        module_vers;

  file_date := "-<( 20-DEC-1988 15:31:35.38 )>-";
  module_vers := substr(file_date,5,2) +
                 substr(file_date,8,3) +
                 substr(file_date,14,2) +
                 substr(file_date,17,5) ;

  return module_vers;

endprocedure;

!*----------------------------------------------------------------------------*!
!
! This procedure will find the match to the current character.
! Valid matches are:
! evedt_matchable_open   := ([{<;
! evedt_matchable_close  := )]}>;

procedure eve_find_matching

local start_position,           ! Marker - current cursor position
      found_position,           ! Marker - position of found matching char
      right_matches,            ! Integer - number of opens to close
      left_matches,             ! Integer - number of closes to open
      all_chars,                ! String - open and close match_chars
      match_pattern,            ! Pattern - any (all_chars)
      match_position,           ! Marker - current position during searches
      target,
      match_chars,
      open_char,
      close_char;

   on_error
    [TPU$_CONTROLC]:
	eve$learn_abort;
	abort;
    [TPU$_STRNOTFOUND]:
        message ("No matching character found.");
        position (start_position);
	abort;
    [OTHERWISE]:
	abort;
  endon_error;

  target := current_character;

  open_type := index(evedt_matchable_open,target);

  if open_type = 0 then
    close_type := index(evedt_matchable_close,target);

    if close_type = 0 then
      message ( ">" + target + "<" + " is not a matchable character. " +
                "Valid characters are ( [ { < > } ] )");
    else  ! search for matching open char
      close_char := target;
      open_char  := substr(evedt_matchable_open,close_type,1);

      start_position := mark (none);
      right_matches := 1;
      move_horizontal (-1);
      match_chars := open_char + close_char;
      all_chars := open_char + close_char;
      match_pattern := any (all_chars);

      loop        ! looking for open char so search backwards
        match_position := search (match_pattern, reverse);
        exitif match_position = 0;
        position (match_position);

        if current_character = substr (match_chars, 1, 1) then
          right_matches := right_matches - 1;
          move_horizontal (-1);
        else
          if current_character = substr (match_chars, 2, 1) then
            right_matches := right_matches + 1;
            move_horizontal (-1);
          endif;
        endif;

        exitif right_matches = 0;
      endloop;

      if right_matches = 0 then
        move_horizontal (1);
        found_position := mark(none);
        match_range := create_range(found_position,start_position,bold);
      endif;
    endif;

  else          ! search for matching close character
    open_char := target;
    close_char  := substr(evedt_matchable_close,open_type,1);

    start_position := mark (none);
    left_matches := 1;
    move_horizontal (1);
    match_chars := open_char + close_char;
    all_chars := open_char + close_char; ! + quote_chars;
    match_pattern := any (all_chars);

    loop        ! looking for close char so search forward
      match_position := search (match_pattern, forward);
      exitif match_position = 0;
      position (match_position);

      if current_character = substr (match_chars, 1, 1) then
        left_matches := left_matches + 1;
        move_horizontal (1);
      else
        if current_character = substr (match_chars, 2, 1) then
          left_matches := left_matches - 1;
        move_horizontal (1);
        endif;
      endif;

      exitif left_matches = 0;
    endloop;

    if left_matches = 0 then
      move_horizontal (-1);  
      found_position := mark(none);
      match_range := create_range(start_position,found_position,bold);
    endif;
  endif;

  position (start_position);

endprocedure;

!*----------------------------------------------------------------------------*!
! This procedure is passed the pair of matching characters and a pair of
! quote characters.

procedure evedt_match (match_chars, quote_chars)

local this_position,            ! Marker - current cursor position
      right_matches,            ! Integer - number of opens to close
      all_chars,                ! String - match_chars + quote_chars
      match_pattern,            ! Pattern - any (all_chars)
      match_position,           ! Marker - current position during searches
      new_string,
      rd_str,
      at_line,
      low_line,
      this_quote;               ! String - current quote character

  on_error
    [TPU$_CONTROLC]:
	eve$learn_abort;
	abort;
    [OTHERWISE]:
	abort;
  endon_error;

    if length (match_chars) <> 2 then
        message ("Must have 2 characters to match");
        return;
    endif;

    at_line := eve_get_line;

    copy_text (substr (match_chars, 2, 1));
    this_position := mark (none);
    right_matches := 1;
    move_horizontal (-1);
    all_chars := match_chars + quote_chars;
    match_pattern := any (all_chars);
    loop
        ! looking for open char so search backwards
        match_position := search (match_pattern, reverse);
        exitif match_position = 0;
        position (match_position);
        if index (quote_chars, current_character) > 0 then
            this_quote := current_character;
            move_horizontal (-1);
            match_position := search (this_quote, reverse);
            exitif match_position = 0;
            position (match_position);
        else
            if current_character = substr (match_chars, 1, 1) then
                right_matches := right_matches - 1;
            else
                right_matches := right_matches + 1;
           endif;
        endif;
        exitif right_matches = 0;
    endloop;

    if right_matches = 0 then
        low_line := eve_get_line;
        evedt_display_line;
        rd_str := "Match found on line " + str(low_line) +
                  " You are on line " + str(at_line);
        new_string := read_line (rd_str);
    else
        !message ("No matching character found");
    endif;

    position (this_position);

endprocedure;

!*----------------------------------------------------------------------------*!

! Internal routine for evedt_match
! Display current line in message window, with current position highlighted

procedure evedt_display_line          ! Display the matching line

local this_position,            ! Marker - current cursor position
      this_line,                ! String - current line
      start_of_line,            ! Marker - Start of current line
      this_offset;              ! Integer - offset of this_position

    this_position := mark (blink);
    this_offset := current_offset;
    move_horizontal (- current_offset);
    start_of_line := mark (none);
    move_horizontal (length (current_line));
    this_line := create_range (start_of_line, mark (none), none);
    message (this_line);
    position (end_of (message_buffer));
    move_vertical (-1);
    move_horizontal (this_offset);
    evedt_this_position := mark (blink);
    position (this_position);

endprocedure;

!*----------------------------------------------------------------------------*!

procedure eve_set_matching(the_arg)     ! Turn on electric open parens

LOCAL   the_key,
        the_keys,
        ptr;

    the_keys := the_arg;

    if (the_keys = "") then
        the_keys := read_line("Match what characters: ");
    endif;
    ptr := 1;
    loop
        exitif (ptr > length(the_keys));
        the_key := substr(the_keys, ptr, 1);
        if (index(evedt_matchable_open, the_key) <> 0) then
            define_key("evedt_insert_matched", key_name(the_key), " typing");
        else
            message('"' + the_key + '" is not matchable');
            return;
        endif;
        ptr := ptr + 1;
    endloop;

endprocedure;

!*----------------------------------------------------------------------------*!

procedure eve_set_nomatching(the_arg)           ! Turn off electric open parens

LOCAL   the_key,
        the_keys,
        ptr;

    the_keys := the_arg;

    if (the_keys = "") then
        the_keys := read_line("Remove matching for what charcters: ");
    endif;
    ptr := 1;
    loop
        exitif (ptr > length(the_keys));
        the_key := substr(the_keys, ptr, 1);
        if (index(evedt_matchable_open, the_key) <> 0) then
            undefine_key(key_name(the_key));
        else
            if (index(evedt_matchable_close, the_key) = 0) then
                message('"' + the_key + '" is not matchable');
                return;
            endif;
        endif;
        ptr := ptr + 1;
    endloop;

endprocedure;

!*----------------------------------------------------------------------------*!

procedure evedt_insert_matched                ! Insert the two caharcters

LOCAL   the_key,
        which;

    the_key := ascii(last_key);
    which := index(evedt_matchable_open, the_key);
    if (which <> 0) then
        evedt_insert_text(the_key);
        evedt_insert_text(substr(evedt_matchable_close, which, 1));
        move_horizontal(-1);
    else
        message("That key isn't matchable.");
        return;
    endif;

endprocedure

!*----------------------------------------------------------------------------*!

! This procedure will find the match to the current begin / end string.

procedure eve_find_be_match

local start_position,           ! Marker - current cursor position
      found_position,           ! Marker - position of found matching char
      betin_matches,            ! Integer - number of opens to close
      end_matches,              ! Integer - number of closes to open
      match_pattern,            ! Pattern - any (all_chars)
      match_position,           ! Marker - current position during searches
      target,
      begin_type,
      end_type,
      org_direction;

   on_error
    [TPU$_CONTROLC]:
        position (start_position);
	eve$learn_abort;
	abort;
    [TPU$_STRNOTFOUND]:
        message ("No matching string found.");
        position (start_position);
	abort;
    [OTHERWISE]:
	abort;
  endon_error;

  if current_character = ' ' then
    message ( "> < is not a begin / end pattern.");
    return;
  endif;

  org_direction := current_direction;

  target := tdd_get_word(eve$read_word_separators);
  edit(target,collapse,lower);

  begin_type := 'begin';
  end_type := 'end';
  end_semi := 'end;';
  match_pattern := begin_type | end_type;

  if target <> begin_type then

    if (target <> end_type) and
       (target <> end_semi) then
      message ( ">" + target + "<" + " is not a begin / end pattern.");
    else  ! search for matching begin

      eve$end_of_word;
      move_horizontal(-1);   
      start_position := mark (none);
      end_matches := 1;

      ! move to the beginning of the word

      if not eve$at_start_of_word then
        eve$start_of_word;
      endif;

      ! set direction reverse

      if current_direction = forward then
        eve_change_direction;
      endif;

      eve_move_by_word;

      loop        ! looking for begin string so search backwards
        match_position := search (match_pattern, reverse);
        exitif match_position = 0;
        position (match_position);

        target := tdd_get_word(eve$read_word_separators);
        edit(target,collapse,lower);

        if target = begin_type then
          end_matches := end_matches - 1;
          move_horizontal (-1);
        else
          if (target = end_type) or
             (target = end_semi) then
            end_matches := end_matches + 1;
            move_horizontal (-1);
          endif;
        endif;

        exitif end_matches = 0;
      endloop;

      if end_matches = 0 then
        move_horizontal (1);
        found_position := mark(none);
        match_range := create_range(found_position,start_position,bold);
      endif;
    endif;
  else          ! search for matching end string
    if not eve$at_start_of_word then
      eve$start_of_word;
    endif;

    start_position := mark (none);
    begin_matches := 1;

    if current_direction = reverse then
      eve_change_direction;
    endif;

    ! move to the beginning of the next word

    eve_move_by_word;

    loop        ! looking for begin string so search forwards
      match_position := search (match_pattern, forward);
      exitif match_position = 0;
      position (match_position);

      target := tdd_get_word(eve$read_word_separators);
      edit(target,collapse,lower);

      if (target = end_type) or
         (target = end_semi) then
        begin_matches := begin_matches - 1;
        move_horizontal (1);
      else
        if target = begin_type then
          begin_matches := begin_matches + 1;
          move_horizontal (1);
        else
          move_horizontal (1);
        endif;
      endif;

      exitif begin_matches = 0;
    endloop;

    if begin_matches = 0 then
      move_horizontal (1);
      found_position := mark(none);
      match_range := create_range(found_position,start_position,bold);
    endif;
  endif;

  position (start_position);

  if current_direction <> org_direction then
    eve_change_direction;
  endif;

endprocedure;

!*----------------------------------------------------------------------------*!