!++
! FILENAME: LEICPROCS.TPU
! FUNCTION: A collection of TPU procedures from Leicester England.
! 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-SEP-1988 Original.
! HISTORY:  current.
! CONTENTS:
!           eve_find_this
!           find_string_at_cursor(flag)
!
!23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H
!--
!*----------------------------------------------------------------------------*!

procedure leicprocs_module_ident 

  local file_date,
        module_vers;

  file_date := "-<( 15-NOV-1988 14:23:51.86 )>-";
  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;

!*----------------------------------------------------------------------------*!
!
! Set up the search string and go find it.

procedure eve_find_this
  find_string_at_cursor(1) ;    ! Find out what we are sitting on.
  eve_find(eve$x_target) ;      ! Go find it.
endprocedure;

!*----------------------------------------------------------------------------*!
!
! Get the word at the current cursor location and stuff it into the global
! variable eve$x_target. The flag=true will cause the searched string to be
! displayed in the message line.

procedure find_string_at_cursor(flag)
local
  len,
  cur_char,
  temp_string;

on_error
  message('Error in GOLD_FIND_THIS ');
endon_error;

len := 1;                       ! zero loop counter
temp_string := '';              ! init temporary string
start_mark := mark(none);
move_horizontal(1);
eve$start_of_word;              ! move to start of filename

! Build the search string a character at a time.

LOOP
  cur_char := current_character;      ! get the current buffer character

  ! Use the following characters as delimiters for string.

  EXITIF cur_char = ' ';              ! SPACE
  EXITIF cur_char = ascii(9);         ! TAB
  EXITIF cur_char = ascii(13);        ! CR (for compatibility with non-standard
  EXITIF cur_char = ascii(10);        ! LF  text files)
  EXITIF cur_char = '(';
  EXITIF cur_char = ')';
  EXITIF cur_char = ',';
  EXITIF cur_char = '=';
  EXITIF cur_char = '+';
  EXITIF cur_char = '^';
  EXITIF cur_char = '"';
  EXITIF cur_char = '''';
  EXITIF cur_char = '/';
  ! EXITIF cur_char = ':';  ! Remove because otherwise we can't find file specs.
  ! EXITIF cur_char = '[';
  ! EXITIF cur_char = ']';
  ! EXITIF cur_char = '-';
  ! EXITIF cur_char = '_';
  ! EXITIF cur_char = ';';
  EXITIF len >132;    ! max size of search string allowed is 132

  temp_string := temp_string + cur_char;
  len := len + 1;               ! count of the unmatched characters
  move_horizontal(1);           ! move our position + 1
  EXITIF CURRENT_OFFSET = 0;    ! stop if we go beond the eol
ENDLOOP;

move_horizontal(-1);            ! always overshoots by one character position

position (start_mark);          ! Leave cursor on the start of the string
delete (start_mark);            ! Don't leave a marker (only used locally)

eve$x_target := temp_string;    ! set up eve variable used as search string

show_search := "Searching for: " + eve$x_target ;

if flag then
  message(show_search);         ! If the flag is set, show the search string
else                            ! Needed to avoid messages from functions that
endif;                          ! use this routine to pick up strings.

endprocedure;

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