!++
! FILENAME: TDDPROCS.TPU
! FUNCTION: Misc. TPU Utilities developed by Tim, augmented by Steve.
! AUTHOR:   Tim D. Devick, 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:     02-SEP-1988 Original.
! HISTORY:  
! CONTENTS: eve_open
!           eve_$getword
!           eve_xtpu
!           eve_clist                   ! clist main proc
!           fetch_list                  ! clist support proc
!           process_percent_includes    ! clist support proc
!           tdd_get_word                ! clist support proc
!           pattern_to_string
!           set_calluser_value
!
!23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H
!--
!*----------------------------------------------------------------------------*!

procedure tddprocs_module_ident 

  local file_date,
        module_vers;

  file_date := "-<( 28-NOV-1988 15:55:39.15 )>-";
  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;

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

! Uses the word the cursor is on as a filename, and GETs the named file.

PROCEDURE eve_open

local   this_word, 
        local_separators, 
        x, 
        len, 
        original_length;

local_separators := eve$$x_word_separators;

x := index(local_separators, ".");
len := length(local_separators);
if x <> 0 then
  local_separators := substr(local_separators, 1, x-1);
  local_separators := local_separators +
    substr(eve$$x_word_separators, x+1, len);
endif;

local_separators := local_separators + "{}^";

this_word := eve_$getword (local_separators);

! remove extra underscores, caused by file names in RUNOFF format

original_length := length(this_word);
loop
   x := index(this_word, "__");
  exitif x = 0;
  this_word := substr(this_word, 1, x) +
    substr(this_word, x + 2, original_length);
endloop;

! add ".PAS" if there is no dot anything on the end of the file name

x  := index(this_word, ".");
if x = 0 then
  edit(this_word, trim); ! get rid of leading/trailing spaces
  this_word := this_word + ".PAS";
endif;

if index (this_word, "[") = 0 then
  this_word := default_directory + this_word;
endif;

marking_enabled := false; ! prevents leaving markers in the SHOW buffer
if eve$x_number_of_windows <> 2 then
  eve_two_windows;
endif;
eve_other_window;
eve$position_in_middle(mark(none));
eve$$enter_command_window;
copy_text (fao ("get file !AS", this_word));
eve$$exit_command_window;
eve$position_in_middle(mark(none));

ENDPROCEDURE;

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

! This procedure returns a string consisting of the current word
! (the word the cursor is on). This procedure acts like a FUNCTION,
! as it returns a value. The parameter "separators" is a string
! to be used as word separators instead of the default. If this string
! is null, then the default word separators will be used.

PROCEDURE eve_$getword (separators)

local   search_string, 
        text_range, 
        start_of_word, 
        where_we_were,
        my_separators;

my_separators := separators;
if my_separators = "" then
  my_separators := eve$$x_word_separators;
endif;

where_we_were := mark (none);
text_range := "";

! find first character in word. if current_character is not a word separator,
! then the loop will exit right away. If the current_character is a word
! separator, then the loop will move_horizontal one character at a time
! until it finds a non word separator character. This should mark the beginning
! of the current word. If the cursor is not on a word separator when
! this loop starts, it exits without really doing anything. In that
! case, the next loop takes over.

loop
  exitif (index (my_separators, current_character) = 0) or
    (current_offset = length (current_line));
  move_horizontal (1);
endloop;

! This loop loops until the current_character is a word separator, or
! it is at the beginning of the line. If you are in the middle of a word,
! it will get you back to the beginning. Between this loop and the previous
! loop, we should end up at the beginning of the current word whether the
! cursor was in front of the word or in the middle of the word when this
! procedure was invoked.

loop
  exitif (index (my_separators, current_character) > 0) or
    (current_offset = 0);        ! at beginning of line
  move_horizontal (-1);
endloop;

if index (my_separators, current_character) > 0 then
  move_horizontal (1);      ! move to the first character in the word
endif;

start_of_word := mark (none);

! This loop starts at the beginning of the current word and loops
! until it finds a word separator, or the end of the line, either
! of which indicate the end of the current word.

loop
  exitif (index (my_separators, current_character) > 0) or
    (current_offset = length (current_line));        ! at end of line
  move_horizontal (1);
endloop;

move_horizontal (-1); ! We are actually one character past the end of the word,
                      ! so move back one character

text_range := create_range (start_of_word, mark (none), none);
erase (eve$prompt_buffer);
position (beginning_of (eve$prompt_buffer));
copy_text (text_range);
position (beginning_of (eve$prompt_buffer));
text_range := current_line;
edit (text_range, trim);       ! delete leading/trailing spaces
position (where_we_were);
return (text_range);

ENDPROCEDURE;

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

! This procedure treats the current line as a TPU command and executes it.
! This isn't done the simple way because this copies the command into the
! command buffer before executing it (and the simple way does not), making it
! available for recall later.

PROCEDURE eve_xtpu

local   command_string, 
        where_we_were;

where_we_were := mark (none);
command_string := current_line;
edit (command_string, trim);
command_string := "Command: tpu " + command_string;
position (end_of (eve$command_buffer));
copy_text (command_string);
command_string := substr (command_string, 10, length (command_string));
eve_do (command_string);
position (where_we_were);

ENDPROCEDURE;

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

 ! This procedure is designed to make correcting source files
 ! easier by allowing you to have a list file in one window, the source
 ! file in the other, and automatically finding the next error in the list
 ! file, and positioning the cursor to the corresponding line in the source
 ! file in the other window.

 ! The procedures fetch_list,
 !                process_percent_includes,
 !                tdd_get_word
 !
 ! which follow are associated with clist.
 
 PROCEDURE eve_clist
 
 local  back_there, 
        char, 
        current_file_name, 
        end_location, 
        indx, 
        line_numbers,
        line_number_pattern, 
        line_number_string, 
        location, 
        pat1, 
        quote_found,
        search_pattern, 
        search_string, 
        temp, 
        this_buffer, 
        tlocation,
        where_we_were, 
        line_number_int;
 
 on_error
   if error <> tpu$_strnotfound then
     message(fao("EVE_CLIST: Error at line !SL", error_line));
   endif;
 endon_error;
 
 error_keyword := "";
 where_we_were := mark (none);      ! mark this location.

 if not list_file_fetched then      ! if the list file isn't open yet, split
   source_buffer := current_buffer; ! screen into two windows, and get list file.
   which_language := fetch_list;
   list_file_fetched := true;
 endif;
 
 if (which_language = unsupported) then
   message ("EVE_CLIST: Unsupported or unrecognized language");
   eve_reset;
   return;
 else
   if (which_language = fetch_list_error) then
     eve_reset; ! error message already issued by FETCH_LIST,so just reset & quit
     return;
   endif;
 endif;
 
 position (eve$bottom_window);             ! make sure we're in the bottom window

 if get_info(current_buffer, "name") <> "LIST" then
   eve_buffer(get_info(list_buffer, "name"));           ! and in the list buffer.
 endif;
 
 if (error_location = 0) and (list_location = 0) then       ! first time through,
   position (beginning_of (list_buffer));        ! go to beginning of list_buffer
 else
   if list_location <> 0 then
     position (end_of (list_location));      ! go to last position in list buffer
   endif;
 endif;
 
 ! this pattern lets SEARCH look for a string consisting of
 ! the beginning-of-line character, plus one or more blank characters,
 ! plus one or more numeric characters
 
 line_number_pattern := line_begin & span (' ') & span ('0123456789');
 
 if which_language = EPASCAL then
   search_string := "%EPASCAL-";
 else
   if which_language = PASCAL then
     search_string := "%PASCAL-";
   else
     search_string := "%CC-";
   endif;
 endif;
 
   search_pattern := search_string & match(",");
   location := search (search_pattern, forward, exact);

   if location = 0 then
     message ("EVE_CLIST: No more errors found in source code.");

     if error_location <> 0 then
       position (error_location);
     endif;
     return;
   endif;
 
   list_location := location;
   position(end_of(location));
 
   if which_language = PASCAL then
     pat1 := line_end;
   else
     pat1 := "." & (" " | line_end);
   endif;
   end_location := search (pat1, forward, exact);

   if end_location <> 0 then
     error_message := create_range (beginning_of (location),
                                    end_of (end_location),
                                    bold);
     update (current_window);
   endif;
 
   position (end_of(location)); ! end of current error prefix on current line.
 
   tlocation := search ("""", forward, exact);

   if (tlocation = 0) then
     quote_found := false;
   else
     if beginning_of (tlocation) > end_of (error_message) then
       quote_found := false;
     else
       quote_found := true;
       position (tlocation);
     endif;
   endif;
 
   if quote_found then      ! quote found, should be error keyword(s)
     move_horizontal (1);   ! move off quote character, or search will hose us
     end_location := search ("""", forward, exact);

     if end_location = 0 then
       message ("EVE_CLIST: No ending quote found");
     endif;
     error_keyword := create_range (beginning_of (tlocation),
                                    end_of (end_location),
                                    none);
     where_we_were := mark (none);
     position (scratch_buffer);
     erase (scratch_buffer);
     copy_text (error_keyword);
     error_keyword := current_line;
     translate (error_keyword, " ", """"); ! replace quote chars into spaces
     edit (error_keyword, trim);
     error_keyword := substr (error_keyword, 1, length (error_keyword));
     position (where_we_were);
 
   else ! no quote found, so look for uppercase character or dollar sign
 
        ! first, look for error-keyword in LIST file
 
     pat1 := span (" (0123456789)") & any("$ABCDEFGHIJKLMNOPQRSTUVWXYZ_^");
     tlocation := search (pat1, forward, exact); ! first char in error text

     if tlocation = 0 then
       message ("EVE_CLIST: INTERNAL ERROR: No error keyword found.");
     endif;
 
     position (end_of (tlocation));
     move_horizontal (1);            ! move off the found character
     pat1 := span ("$ABCDEFGHIJKLMNOPQRSTUVWXYZ_");
     tlocation := search (pat1, forward, exact); ! error keyword (hopefully)

     if tlocation = 0 then
       message ("EVE_CLIST: INTERNAL ERROR: No error keyword found.");
     endif;

     position (tlocation);

     error_keyword := tdd_get_word(eve$read_word_separators);
   endif;
 
   position (location);
 
   move_vertical (1);
   move_horizontal (-current_offset); ! go to start of line before "%EPASCAL-".
   position (location);
 
   ! search backwards from "%EPASCAL-" for the line that contains the
   ! line number that identifies the line of text where the error occurred.
   ! this will return a range starting at the begining of the line and
   ! including the line number string.
 
   line_numbers := search (line_number_pattern, reverse, exact);

   if line_numbers = 0 then
     line_number_pattern := line_begin & span("0123456789");
     line_numbers := search(line_number_pattern, reverse, exact);
     if line_numbers = 0 then
       message ("EVE_CLIST: INTERNAL ERROR: Can't find line numbers.");
       return;
     endif;
   endif;
 
   position (line_numbers);
 
   ! search forward from start of the line containing the line number
   ! to the actual line numbers in that line.
 
   line_numbers := search (span ('0123456789'), forward, exact);

   if line_numbers = 0 then
     message ("EVE_CLIST: INTERNAL ERROR: Can't find line numbers.");
     return;
   endif;
 
   position (line_numbers);
 
   line_number_string := '';
   indx := current_offset;
   ok := 0;
 
   ! this loop builds the line number string which will be converted to
   ! an integer and used to position the cursor in the source file window
   ! to the line that caused the error.
 
   loop
     char := substr (current_line, indx + 1, 1);
 
     case char from '0' to '9'
 
     [inrange]  : ok := 1;
 
     [outrange] : ok := 0;
 
     endcase;
 
     exitif ok = 0;
     line_number_string := line_number_string + char;
     indx := indx + 1;
   endloop;
 
   position (location); ! the start of the "%EPASCAL-" line
 
   line_number_int := INT (line_number_string); ! convert the line number string
                                                ! built in the loop to an integer.
 
   ! the unmapping and mapping here moves the error line to the top of the
   ! list file window
 
   eve_other_window;       ! move the cursor to the source file window
   source_buffer := current_buffer;
!   eve_set_scroll_margins("25%","25%");  ! default scrolling, like EDT
   update (eve$bottom_window);
 
   eve_line(line_number_int - include_diff, ""); ! move to line that caused the error
 
   if error_keyword <> "" then
     error_location := search (error_keyword, forward, no_exact);
     if error_location <> 0 then
       error_range := create_range (beginning_of (error_location),
                                    end_of (error_location),
                                    bold);
       position (beginning_of (error_location));
     endif;
   endif;
 
!   eve_set_scroll_margins("25%","25%");  ! default scrolling, like EDT
 
 ENDPROCEDURE;

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

 ! Called by EVE_CLIST to figure out what the appropriate list file is
 ! (assuming the file in the current buffer is compiled source file), and
 ! fetch the list file. Not designed to be executed directly by the 'DO' key.
 
 PROCEDURE fetch_list
 
 local  input_file, 
        save_input_file, 
        location, 
        pat1, 
        temp, 
        temp_string,
        where_we_were, 
        dummy;
 
   where_we_were := current_buffer;
 
   set (timer, on, "Working...");     ! turn on "Working..." message
 
   input_file := get_info (current_buffer, "file_name");
   save_input_file := input_file;
 !  location := length (input_file);
 
   input_file := file_parse(input_file,"","",device, directory, name) + ".lis";

   if input_file = "" then
     message("FETCH_LIST: Invalid list file name.");
     return(0);
   endif;
 
 !  message(fao("input_file = !AS",input_file));

   if file_search(input_file) = "" then ! no such file
     message("FETCH_LIST: Can't find .LIS file.");
     return(0);
   endif;
 
   erase (list_buffer);
   position (list_buffer);
 !  set (screen_update, off);
   read_file(input_file);
   position (message_buffer);
   copy_text (" ");
 !  position (list_buffer);
   position (where_we_were); ! source buffer
   eve_two_windows;     ! this always leaves you in the bottom window

   if get_info(current_buffer,"name") <> "LIST" then
     eve_buffer("list");  ! map bottom window onto list buffer
   endif;

   position(beginning_of(list_buffer));
 
   temp_string := file_parse(save_input_file, "", "", type);
 
 !  pat1 := "" & ("VAXELN Pascal" | "VAX C" | "VAX Pascal" | "Page ")@temp;
 !  location := search (pat1, forward, no_exact);
 !  if location = 0 then
 !    message("internal error - language string not found");
 !    return(0);
 !  else
 !    temp_string := pattern_to_string(temp);
     edit(temp_string,upper);

     if temp_string = ".PAS" then
       which_language := EPASCAL;
     else
       if temp_string = ".C" then
         which_language := CC;
 !      else
 !        if temp_string = "VAX PASCAL" then
 !          which_language := PASCAL;
         else
           which_language := UNSUPPORTED;
         endif;
 !     endif;
     endif;
 !  endif;
 !  message("start process_percent_includes");
   include_diff := process_percent_includes;
 !  message("end process_percent_includes");
 !  set (screen_update, on);
   set (timer, off);
   return (which_language);
 
 ENDPROCEDURE;

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

 ! used with EVE_CLIST so "%INCLUDE" compiler commands in EPASCAL don't
 ! cause it CLIST to get lost. Every "%INCLUDE" screws up the numbering
 ! correspondance between the source and the list files. This routine
 ! calculates how large the included file and returns that value to CLIST
 ! which uses that value as a fudge factor in locating the source line
 ! that corresponds to a listing error line.

 PROCEDURE process_percent_includes
 
 local  pat1, 
        location, 
        line_number_pattern, 
        line_number_int, 
        diff_number, 
        diff;

 on_error
   message(fao ("PROCESS_PERCENT_INCLUDE: Error at line !SL", error_line));
 endon_error;
 
 position (beginning_of (list_buffer));

 if which_language = CC then
   pat1 := "#include";
 else
   pat1 := "%include";
 endif;

 location := search_quietly (pat1, forward, no_exact);

 if location = 0 then
   return(0);
 endif;
 position (beginning_of (location));

 position (search_quietly (line_begin, reverse));

 line_number_pattern := span ('0123456789');

 location := search_quietly (line_number_pattern, forward, no_exact);

 if location = 0 then
   return(0);
 endif;

 position (location);
 line_number_int := int(pattern_to_string(location));
 
 ! now we have the line number of the first %INCLUDE statement,
 ! so let's get the line number of the last %INCLUDE statement
 ! and compute the difference so we can compensate.
 
 position(end_of(list_buffer));

 location := search_quietly (pat1, reverse, no_exact);

 if location = 0 then
   return(0);
 endif;

 position(beginning_of(location));

 location := search_quietly (line_number_pattern, forward, no_exact);

 if location = 0 then
   return(0);
 endif;

 position (beginning_of(location));
 diff_number := int(pattern_to_string(location));
 diff_number :=  diff_number - line_number_int - 1;
 return(diff_number);
 
 ENDPROCEDURE;

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

 ! Used by eve_clist.
 ! This procedure returns a string consisting of the current word
 ! (the word the cursor is on). This procedure acts like a FUNCTION,
 ! as it returns a value. The parameter "separators" is a string
 ! to be used as word separators instead of the default. If this string
 ! is null, then the default word separators will be used.
 
 PROCEDURE tdd_get_word (separators)
 
 local  text_range, 
        start_of_word, 
        where_we_were,
        my_separators;
 
 my_separators := separators;

 if my_separators = "" then
   my_separators := eve$read_word_separators;
 endif;
 
 where_we_were := mark (none);
 text_range := "";
 
 ! find first character in word. if current_character is not a word separator,
 ! then the loop will exit right away. If the current_character is a word
 ! separator, then the loop will move_horizontal one character at a time
 ! until it finds a non word separator character. This should mark the beginning
 ! of the current word. If the cursor is not on a word separator when
 ! this loop starts, it exits without really doing anything. In that
 ! case, the next loop takes over.
 
 loop
   exitif (index (my_separators, current_character) = 0) or
     (current_offset = length (current_line));
   move_horizontal (1);
 endloop;
 
 ! This loop loops until the current_character is a word separator, or
 ! it is at the beginning of the line. If you are in the middle of a word,
 ! it will get you back to the beginning. Between this loop and the previous
 ! loop, we should end up at the beginning of the current word whether the
 ! cursor was in front of the word or in the middle of the word when this
 ! procedure was invoked.
 
 loop
   exitif (index (my_separators, current_character) > 0) or
     (current_offset = 0);        ! at beginning of line
   move_horizontal (-1);
 endloop;
 
 if index (my_separators, current_character) > 0 then
   move_horizontal (1);      ! move to the first character in the word
 endif;
 
 start_of_word := mark (none);
 
 ! This loop starts at the beginning of the current word and loops
 ! until it finds a word separator, or the end of the line, either
 ! of which indicate the end of the current word.
 
 loop
   exitif (index (my_separators, current_character) > 0) or
     (current_offset = length (current_line));        ! at end of line
   move_horizontal (1);
 endloop;
 
 move_horizontal (-1); ! We are actually one character past the end of the word,
                       ! so move back one character
 
 text_range := create_range (start_of_word, mark (none), none);
 erase (eve$prompt_buffer);
 position (beginning_of (eve$prompt_buffer));
 copy_text (text_range);
 position (beginning_of (eve$prompt_buffer));
 text_range := current_line;
 edit (text_range, trim);       ! delete leading/trailing spaces
 position (where_we_were);
 return (text_range);
 
 ENDPROCEDURE;

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

! This procedure converts a pattern variable into a one-line string.

PROCEDURE pattern_to_string (which_pattern)

local   where_we_were, 
        pattern_string;

where_we_were := mark(none);
erase(scratch_buffer);
position(scratch_buffer);
copy_text(which_pattern);
pattern_string := current_line;
position(where_we_were);
return(pattern_string);

ENDPROCEDURE;

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

PROCEDURE set_calluser_value;

calluser := false; ! false for Tim, false for Lori/Skip
if get_info(tpu_1, "type") <> process then
  tpu_1 := 0;
endif;

ENDPROCEDURE;