MODULE TPUPlus_MATCH IDENT "900409"
!
! Matching utility procedures
!   PROCEDURE EVE_SET_MATCHING (THE_ARG)
!   PROCEDURE EVE_SET_NOMATCHING (THE_ARG)
!   PROCEDURE EVEPLUS_INSERT_MATCHED
!   PROCEDURE EVEPLUS_MATCH (MATCH_CHARS, QUOTE_CHARS)
!   PROCEDURE EVEPLUS_DISPLAY_LINE
!   PROCEDURE EVE_SET_FLASHING (ARG)    ! does not seem to be working 
!   PROCEDURE EVE_SET_NOFLASHING (ARG)  ! actually the flash code in 
!                                       ! EVEPLUS_MATCH is not working right
!                                       ! (I think)
!   PROCEDURE PCE$MATCH_STATUS_FIELD (THE_LENGTH, THE_FORMAT)
!   PROCEDURE PCE$FLASH_STATUS_FIELD (THE_LENGTH, THE_FORMAT)
!
!   This module is provided "as is" (usually I don't include this in my
!   section file).  Anyone wishing to improve, alter, or otherwise change 
!   the code contained within this module should 'knock themselves out'.
!   I have no intention of working to improve this module.
!

!****************************************
PROCEDURE EVE_SET_MATCHING(THE_ARG)    ! TURN ON ELECTRIC OPEN PARENS
!+
! MATCHING.TPU - Routine to automatically insert close parentheses etc.
!-
LOCAL   the_key,
        the_keys,
        ptr;

on_error
endon_error;

the_keys := the_arg;

if (the_keys = "") then
    the_keys := read_line("Match what characters: ");
endif;
edit(the_keys,upper);

if the_keys = "ALL" then
    the_keys := eveplus_matchable_open;
endif;

ptr := 1;
loop
    exitif (ptr > length(the_keys));
    the_key := substr(the_keys, ptr, 1);
    if (index(eveplus_matchable_open, the_key) <> 0) then
        define_key ("eveplus_insert_matched", key_name(the_key), 
            " typing", "pce$match_keys");
    else
        message('"' + the_key + '" is not matchable');
        return;
    endif;
    ptr := ptr + 1;
endloop;

pce$match_keys := the_keys;
pce$match_flag := "MATCH";
add_key_map (eve$x_key_map_list, "first", "pce$match_keys");
eve$update_status_lines;

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_SET_NOMATCHING(THE_ARG)
LOCAL   the_key,
        the_keys,
        ptr;

on_error
endon_error;

the_keys := the_arg;

if (the_keys = "") then
    the_keys := read_line("Remove matching for what charcters: ");
endif;
edit(the_keys,upper);

if the_keys = "ALL" then
    the_keys := eveplus_matchable_open;
    remove_key_map  (eve$x_key_map_list, "pce$match_keys", all);
    pce$match_keys := "";
    pce$match_flag := "";
    eve$update_status_lines;
    return;
endif;

ptr := 1;
loop
    exitif (ptr > length(the_keys));
    the_key := substr(the_keys, ptr, 1);
    if (index(eveplus_matchable_open, the_key) <> 0) then
        undefine_key (key_name (the_key), "pce$match_keys");
    else
        if (index(eveplus_matchable_close, the_key) = 0) then
            message('"' + the_key + '" is not matchable');
            return;
        endif;
    endif;
    ptr := ptr + 1;
endloop;

pce$match_keys := the_keys;
pce$match_flag := "MATCH";
eve$update_status_lines;

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS_INSERT_MATCHED
LOCAL   the_key,
        which,
        this_mode;

the_key := ascii(last_key);
which   := index(eveplus_matchable_open, the_key);
this_mode := get_info (current_buffer, "mode");

if (which <> 0) then
    set (insert, current_buffer);    
    copy_text (the_key);
    copy_text (substr(eveplus_matchable_close, which, 1));
    set (this_mode, current_buffer);    
    move_horizontal(-1);
else
    message("That key isn't matchable.");
    return;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS_MATCH (MATCH_CHARS, QUOTE_CHARS)

! Insert the second of two match characters (close character), and display
! the line with the matching open character in the message window, with
! the open character highlighted.  Try to handle quotes by skipping over
! strings when encountered - doesn't work perfectly if already in a quoted
! strings.  Doesn't handle comments.
!
! Parameters:
!
!       match_chars             String - characters to be matched; e.g. "()"
!       quote_chars             String - quote characters; e.g. "'"""

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
      this_quote;               ! String - current quote character

on_error
! Just continue
endon_error;

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

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
    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
    eveplus_display_line;
else
    message ("No matching parentheses found");
endif;

position (this_position);

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS_DISPLAY_LINE

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

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);
eveplus_this_position := mark (blink);
position (this_position);

ENDPROCEDURE;

!****************************************
!PROCEDURE EVE_SET_FLASHING(ARG)
!
!LOCAL   the_key,
!        the_keys,
!        key_number,
!        ptr;
!
!on_error
!endon_error;
!
!eve$prompt_string(arg, the_keys, "Flash what characters: ", "No flashing set");
!
!edit(the_keys,upper);
!
!if the_keys = "ALL" then
!    the_keys := eveplus_matchable_close;
!endif;
!
!ptr := 1;
!loop
!    exitif (ptr > length(the_keys));
!    the_key := substr(the_keys, ptr, 1);
!    key_number := index(eveplus_matchable_close, the_key);
!    if (key_number <> 0) then
!        define_key ("eveplus_match ('"
!            + substr(eveplus_matchable_open, key_number, 1)
!            + the_key
!            + "', '""''')",
!            key_name (the_key),
!            " typing", "pce$flash_keys");
!    else
!        message('"' + the_key + '" is not matchable');
!        return;
!    endif;
!    ptr := ptr + 1;
!endloop;
!
!pce$flash_keys := the_keys;
!pce$flash_flag := "FLASH";
!add_key_map (eve$x_key_map_list, "first", "pce$flash_keys");
!eve$update_status_lines;
!
!ENDPROCEDURE;
!
!!****************************************
!PROCEDURE EVE_SET_NOFLASHING(ARG)
!
!LOCAL   the_key,
!        the_keys,
!        ptr;
!
!on_error
!endon_error;
!
!eve$prompt_string(arg, the_keys, "Remove flashing for what charcters: ",
!    "No flashing characters removed");
!
!edit(the_keys,upper);
!
!if the_keys = "ALL" then
!    the_keys := eveplus_matchable_close;
!    remove_key_map  (eve$x_key_map_list, "pce$flash_keys", all);
!    pce$flash_keys := "";
!    pce$flash_flag := "";
!    eve$update_status_lines;
!    return;
!endif;
!
!ptr := 1;
!loop
!    exitif (ptr > length(the_keys));
!    the_key := substr(the_keys, ptr, 1);
!    if (index(eveplus_matchable_close, the_key) <> 0) then
!        undefine_key (key_name (the_key), "pce$flash_keys");
!    else
!        if (index(eveplus_matchable_open, the_key) = 0) then
!            message('"' + the_key + '" is not matchable');
!            return;
!        endif;
!    endif;
!    ptr := ptr + 1;
!endloop;
!
!pce$flash_keys := the_keys;
!pce$flash_flag := "FLASH";
!eve$update_status_lines;
!
!ENDPROCEDURE;

!****************************************
PROCEDURE PCE$MATCH_STATUS_FIELD (THE_LENGTH, THE_FORMAT)

if pce$match_flag = "MATCH" then
    return (fao (the_format, "Match " + pce$match_keys));
else
    return "";
endif;

ENDPROCEDURE;
!!****************************************
!PROCEDURE PCE$FLASH_STATUS_FIELD (THE_LENGTH, THE_FORMAT)
!
!if pce$flash_flag = "FLASH" then
!    return (fao (the_format, "Flash " + pce$flash_keys));
!else
!    return "";
!endif;
!
!ENDPROCEDURE;

eve$arg1_set_matching   := 'string';
eve$arg1_set_nomatching := 'string';
!eve$arg1_set_flashing   := 'string';
!eve$arg1_set_noflashing := 'string';
eveplus_matchable_open  := "([{<«'`""";
eveplus_matchable_close := ")]}>»''""";

pce$match_flag := "";
pce$match_keys := "";

create_key_map  ("pce$match_keys");
!create_key_map  ("pce$flash_keys");

ENDMODULE;