MODULE TPUPlus_SPEL IDENT "910102"
!
! Spell checker code module
!
! Spell checker utility procedures
!   PROCEDURE EVE_SPELL (SPELL_PARAMETER)
!   PROCEDURE EVE_LOAD_USER_DICTIONARY
!   PROCEDURE EVE_UPDATE_USER_DICTIONARY
!   PROCEDURE LOAD_DICTIONARIES
!   PROCEDURE SPELL_CHECK_RANGE (SPELL_RANGE)
!   PROCEDURE CHECK_FOR_PARAGRAPH_BREAK
!   PROCEDURE SPELL_CHECK_C
!   PROCEDURE SPELL_CHECK_DCL
!   PROCEDURE SPELL_CHECK_FORTRAN
!   PROCEDURE SPELL_CHECK_MACRO
!   PROCEDURE SPELL_CHECK_RNO
!

!****************************************
PROCEDURE EVE_SPELL (SPELL_PARAMETER)
!---------------------------------------------------------------------------
!  Select A Range Of Lines In The Current Buffer To Spell Check
!  And The Method Of How It Will Be Checked
!---------------------------------------------------------------------------
local cmd,              ! string  - first letter of selection
      current,          ! marker  - current position
      start_paragraph,  ! marker  - start of the current paragraph
      end_paragraph,    ! marker  - end of the current paragraph
      spell_range;      ! range   - range to be spell checked

! set the buffer direction to forward

set (forward, current_buffer);

! check for empty buffer

if beginning_of (current_buffer) = end_of (current_buffer) then
   message ('Buffer empty');
   return (1);
endif;

! load the dictionaries if they are not already available

if dictionary$available = 0 then
   if load_dictionaries = 0 then
      return (1);
   endif;
endif;

! check for empty (null) parameter, if yes spell check current buffer.
! but 1st check to see if user has SELECTed a range using keypad
if (eve$x_select_position <> 0) or (eve$x_box_array <> 0) then
    spell_range := select_range;
    if spell_range <> 0 then
        if spell_check_range (spell_range)then
            message ('End of Spelling Check');
        endif;
        eve$x_select_position := 0;
        eve$x_box_array := 0;
        return (1);
    endif;
endif;

! check if the spell parameter is null (all)
if length (spell_parameter) = 0 then
   spell_range := create_range (beginning_of (current_buffer),
                  end_of (current_buffer), none);
   if spell_check_range (spell_range)then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! get the first character of the parameter

change_case (spell_parameter, upper);

cmd := substr (spell_parameter, 1, 1);
edit (cmd, UPPER);

! check if the spell parameter is 'HERE'
if cmd = 'H' then
   move_horizontal (-current_offset);
   spell_range := create_range (mark (none), end_of (current_buffer), none);
   if spell_check_range (spell_range)then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'BUFFER'
if cmd = 'B' then
   spell_range := create_range (beginning_of (current_buffer),
                  end_of (current_buffer), none);
   if spell_check_range (spell_range)then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'PARAGRAPH'
if cmd = 'P' then
! save current position
   current := mark (none);

! find the beginning of the current paragraph
   move_horizontal (-current_offset);
   loop
      exitif mark (none) = beginning_of (current_buffer);
      move_vertical (-1);
      if check_for_paragraph_break then
         move_vertical (1);
         exitif 1;
      endif;
   endloop;

   start_paragraph := mark (none);

! find the end of the current paragraph
   position (current);

   move_horizontal (-current_offset);

   loop
      exitif mark (none) = end_of (current_buffer);
      exitif check_for_paragraph_break;
      move_vertical (1);
   endloop;

   end_paragraph := mark (none);

! set the spell check range to current paragraph
   spell_range := create_range (start_paragraph, end_paragraph, none);

   if spell_check_range (spell_range)then
      message ('End of Spelling Check');
   endif;
   return (1);

endif;

! check if the spell parameter is 'C'
if cmd = 'C' then
   if spell_check_c then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'DCL'
if cmd = 'D' then
   if spell_check_dcl then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'FORTRAN'
if cmd = 'F' then
   if spell_check_fortran then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'MACRO'
if cmd = 'M' then
   if spell_check_macro then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'RNO'
if cmd = 'R' then
   if spell_check_rno then
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! display error message
message (fao ('Unknown spell parameter (!AS)', spell_parameter));

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_LOAD_USER_DICTIONARY
!---------------------------------------------------------------------------
!  Load The Words In The User Dictionary Into A Special Buffer
!---------------------------------------------------------------------------
local dummy_buffer, ! buffer - place holder in routine call
      count,        ! integer - word count
      func,         ! integer - call_user function code
      retstr;       ! string  - call_user returned string

! save the current buffer

default$buffer := current_buffer;

! test if the user dictionary buffer already exists

if test_if_buffer_exists ('USER DICTIONARY', dummy_buffer) = 0 then
    dictionary$buffer := create_buffer ('USER DICTIONARY');
    set (system, dictionary$buffer);        ! tag as non-user buffer
    set (modified, dictionary$buffer, off); ! not modified
    set (no_write, dictionary$buffer, on);  ! don't even consider writing it
endif;

! empty the user dictionary buffer and map it to the current window

erase (dictionary$buffer);
map (current_window, dictionary$buffer);
eve$set_status_line (current_window);

! get first word from use dictionary

func := 8;
retstr := call_user (func, '');

! if no word was found insert the default word list into the buffer
! otherwise insert word from user dictionary into the buffer

if (func = 0) or (retstr = "") then
   copy_text ('adpc');
   split_line;
   copy_text ('adpce');
   split_line;
   message ('User dictionary empty, initial word list loaded into buffer');
else
   copy_text (retstr);
   count := 1;
   loop
      func := 9;
      retstr := call_user (func, '');
      exitif (func = 0) or (retstr = "");
      split_line;
      copy_text (retstr);
      count := count + 1;
   endloop;
   message (fao ('!SL word(s) loaded from user dictionary', count));
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_UPDATE_USER_DICTIONARY
!---------------------------------------------------------------------------
!  Insert The Words In The Current Buffer Into The User Dictionary
!---------------------------------------------------------------------------
local word_pattern, ! pattern - word recognition pattern
      word_range,   ! range   - range of current word
      word_count,   ! integer - number of words saved in dictionary
      func,         ! integer - call_user function code
      ret;          ! string  - call_user returned string (not used)

! ignore string not found error

on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact system support');
      return (0);
   endif;
endon_error;

! set the buffer direction to forward

set (forward, current_buffer);

! initialize use dictionary data structure(s)

func := 5;
ret  := call_user (func, '');

! insert all of the words in the current buffer into the user dictionary

word_pattern := span ('abcdefghijklmnopqrstuvwxyz');

position (beginning_of (current_buffer));
word_count := 0;

loop
   word_range := search (word_pattern, forward, no_exact);
   exitif word_range = 0;
   exitif beginning_of (word_range) >= end_of (current_buffer);
   word_range := create_range (beginning_of (word_range),
                 end_of (word_range), reverse);
   update (current_window);
   func := 6;
   ret  := call_user (func, substr (word_range, 1, length (word_range)));
    edit (ret, trim);
    func := int (ret);
    if (func = 1) then
        word_count := word_count + 1;
        word_range := create_range (beginning_of (word_range),
                    end_of (word_range), none);
        position (end_of (word_range));
        cursor_horizontal (1);
    else
        if (func = 2) then
            message ('Error - maximum word size exceeded');
        endif;
        if (func = 3) then
            message ('Error - word buffer overflow');
        endif;
        if (func = 4) then
            message ('Error - maximum number of words exceeded');
        endif;
        word_range := create_range (beginning_of (word_range),
                    end_of (word_range), none);
        return (0);
    endif;
endloop;

position (end_of (current_buffer));

! write the user dictionary data structure(s) to a file
func := 7;
ret  := call_user (func, '');
edit (ret, trim);
func := int (ret);

if (func = 1) then
   if default$buffer <> 0 then
     map (current_window, default$buffer);
     eve$set_status_line (current_window);
   endif;
   message (fao ('!SL word(s) stored in user dictionary file', word_count));
else
   if (func = 2) then
      message ('Error opening user dictionary file');
   endif;
   if (func = 3) then
      message ('Error writing user dictionary file');
   endif;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE LOAD_DICTIONARIES
!---------------------------------------------------------------------------
!  Load Dictionaries Into Internal Data Structure(s)
!---------------------------------------------------------------------------
local project_dict,     ! integer - project dict available flag
      use_dict,         ! integer - user dictionary available flag
      func,             ! integer - call_user function code
      ret;              ! string  - call_user returned string (not used)

message ('Loading common, project and user dictionaries');

! load common dictionary

func := 1;
ret := call_user (func, '');
edit (ret, trim);
func := int (ret);
if (func = 0) then
   message ('Error - common dictionary not found');
   return (0);
endif;

! load project dictionary

func := 2;
ret := call_user (func, '');
edit (ret, trim);
func := int (ret);
if (func = 1) then
   project_dict := 1;
else
   project_dict := 0;
endif;

! load user dictionary

func := 3;
ret := call_user (func, '');
edit (ret, trim);
func := int (ret);
if (func = 1) then
   user_dict := 1;
else
   user_dict := 0;
endif;

! display a warning messages if appropriate

if (project_dict = 0) and (user_dict = 0) then
   message ('Warning - project and user dictionaries not found');
endif;

if (project_dict = 0) and (user_dict = 1) then
   message ('Warning - project dictionary not found');
endif;

if (project_dict = 1) and (user_dict = 0) then
   message ('Warning - user dictionary not found');
endif;

dictionary$available := 1;

return (1);

ENDPROCEDURE;

!****************************************
PROCEDURE SPELL_CHECK_RANGE (SPELL_RANGE)
!---------------------------------------------------------------------------
!  Spell Check A Specified Range
!---------------------------------------------------------------------------
local word_range,       ! range   - range of current word
      word_pattern,     ! pattern - word recognition pattern
      replacement_word, ! string  - replacement word
      func,             ! integer - call_user function code
      ret;              ! string  - call_user returned string (not used)

! ignore string not found error

on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact system support');
      return (0);
   endif;
endon_error;

! set buffer direction

set (forward, current_buffer);

! check the spelling of all of the words within the range

word_pattern := span ('abcdefghijklmnopqrstuvwxyz');

position (beginning_of (spell_range));

loop
    word_range := search (word_pattern, forward, no_exact);
    exitif word_range = 0;
    exitif beginning_of (word_range) >= end_of (spell_range);
    position (end_of (word_range));
!    word_range := create_range (beginning_of (word_range),
!                  end_of (word_range), reverse);
!    word_range := create_range (beginning_of (word_range),
!                  end_of (word_range), underline);
!    word_range := create_range (beginning_of (word_range),
!                  end_of (word_range), blink);
    word_range := create_range (beginning_of (word_range),
                  end_of (word_range), bold);
!    update (current_window);
    func := 4;
    ret := call_user (func, substr (word_range, 1, length (word_range)));
    edit (ret, trim);
    func := int (ret);
    if (func = 0) then
        update (current_window);
        eve$position_in_middle (mark (none));
        replacement_word := read_line ('Enter replacement word : ');
        update (eve$command_window);
        if last_key = ctrl_z_key then
            word_range := create_range (beginning_of (word_range),
                end_of (word_range), none);
            return (1);
        endif;
        if length (replacement_word) > 0 then
            erase (word_range);
            copy_text (replacement_word);
            update (current_window);
        endif;
    endif;
    word_range := create_range (beginning_of (word_range),
        end_of (word_range), none);
    move_horizontal (1);
endloop;

position (end_of (spell_range));

return (1);
                                                         
ENDPROCEDURE;

!****************************************
PROCEDURE CHECK_FOR_PARAGRAPH_BREAK
!---------------------------------------------------------------------------
!  Check If The Current Line Is A Paragraph Break
!---------------------------------------------------------------------------
local paragraph_break;

on_error
    return (0);
endon_error;

paragraph_break := anchor & line_begin &
                ((eve$x_null | span (word_separators)) & line_end);

if search (paragraph_break, forward) <> 0 then
    return (1);
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE SPELL_CHECK_C
!---------------------------------------------------------------------------
!  Spell Check A C Source Code File
!---------------------------------------------------------------------------
local spell_range,  ! range   - range to be spell checked
      pat1;         ! pattern - comment recognition pattern

on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact system support');
      return (0);
   endif;
endon_error;

! create recognition pattern(s)

pat1 := '/*' & match ('*/');           ! C comment

! spell check comments

position (beginning_of (current_buffer));

loop
   spell_range := search (pat1, forward);
   exitif spell_range = 0;
   spell_check_range (spell_range);
   if last_key = ctrl_z_key then
      return (1);
   endif;
   position (end_of (spell_range));
endloop;

position (end_of (current_buffer));

return (1);

ENDPROCEDURE;

!****************************************
PROCEDURE SPELL_CHECK_DCL
!---------------------------------------------------------------------------
!  Spell Check A DCL Command File
!---------------------------------------------------------------------------
local spell_range,  ! range   - range to be spell checked
      pat1;         ! pattern - comment recognition pattern

on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact system support');
      return (0);
   endif;
endon_error;

! create recognition pattern(s)

pat1 := any ("!") & remain;            ! DCL comment

! spell check comments

position (beginning_of (current_buffer));

loop
   exitif mark (none) = end_of (current_buffer);
   move_horizontal (-current_offset);
   spell_range := search (pat1, forward, no_exact);  ! look for a comment
   if spell_range <> 0 then
      spell_check_range (spell_range);
      if last_key = ctrl_z_key then
         return (1);
      endif;
   endif;
   move_vertical (1);
endloop;

position (end_of (current_buffer));

return (1);

ENDPROCEDURE;

!****************************************
PROCEDURE SPELL_CHECK_FORTRAN
!---------------------------------------------------------------------------
!  Spell Check A FORTRAN Source Code File
!---------------------------------------------------------------------------
local spell_range,  ! range   - range to be spell checked
      pat1,         ! pattern - comment recognition pattern
      pat2,         ! pattern - comment recognition pattern
      pat3;         ! pattern - character constant recognition pattern

on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact system support');
      return (0);
   endif;
endon_error;

! create recognition pattern(s)

pat1 := anchor & line_begin & ("c" | "C") & remain;  ! FORTRAN comment
pat2 := any ("!") & remain;                           ! FORTRAN comment
pat3 := any ("'") & scan ("'");                        ! character constant

! spell check comments

position (beginning_of (current_buffer));

loop

   ! look for comment lines starting with a "C" in column one

   exitif mark (none) = end_of (current_buffer);
   move_horizontal (-current_offset);
   spell_range := search (pat1, forward);
   if spell_range <> 0 then
      if length (spell_range) > 1 then
         move_horizontal (1);
         spell_range := create_range (mark (none), end_of (spell_range), none);
         spell_check_range (spell_range);
         if last_key = ctrl_z_key then
            return (1);
         endif;
      endif;
   else

      ! look for comment starting with a "!"

      spell_range := search (pat2, forward, no_exact);
      if spell_range <> 0 then
         spell_check_range (spell_range);
         if last_key = ctrl_z_key then
            return (1);
         endif;
      endif;
   endif;
   move_vertical (1);
endloop;

! spell check character constants

message ('Spell checking all character constants');

position (beginning_of (current_buffer));

loop
   exitif mark (none) = end_of (current_buffer);
   spell_range := search (pat3, forward, no_exact);
   exitif spell_range = 0;
   spell_check_range (spell_range);
   exitif last_key = ctrl_z_key;
   position (end_of (spell_range));
   move_horizontal (1);
endloop;

position (end_of (current_buffer));

return (1);

ENDPROCEDURE;

!****************************************
PROCEDURE SPELL_CHECK_MACRO
!---------------------------------------------------------------------------
!  Spell Check A MACRO Source Code File
!---------------------------------------------------------------------------
local spell_range,  ! range   - range to be spell checked
      pat1;         ! pattern - comment recognition pattern

on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact system support');
      return (0);
   endif;
endon_error;

! create recognition pattern(s)

pat1 := any (";") & remain;

! spell check comments                ! MACRO comment

position (beginning_of (current_buffer));

loop
   exitif mark (none) = end_of (current_buffer);
   move_horizontal (-current_offset);
   spell_range := search (pat1, forward, no_exact);  ! look for a comment
   if spell_range <> 0 then
      spell_check_range (spell_range);
      if last_key = ctrl_z_key then
         return (1);
      endif;
   endif;
   move_vertical (1);
endloop;

position (end_of (current_buffer));

return (1);

ENDPROCEDURE;

!****************************************
PROCEDURE SPELL_CHECK_RNO
!---------------------------------------------------------------------------
!  Spell Check A RUNOFF Source Code File
!---------------------------------------------------------------------------
local spell_range,  ! range   - range to be spell checked
      pat1;         ! pattern - command recognition pattern

on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact system support');
      return (0);
   endif;
endon_error;

message ('Spell checking all text');

! create recognition pattern(s)
pat1 := anchor & notany (".") & remain; ! RUNOFF command

position (beginning_of (current_buffer));
loop
   exitif mark (none) = end_of (current_buffer);
   spell_range := search (pat1, forward, no_exact);
   if spell_range <> 0 then
      spell_check_range (spell_range);
      if last_key = ctrl_z_key then
         return (1);
      endif;
   endif;
   move_horizontal (-current_offset);
   move_vertical (1);
endloop;

! spell check comments
message ('Spell checking all RUNOFF commands with imbedded text');

! create recognition pattern(s)
pat1 := any (";") + remain;

position (beginning_of (current_buffer));
loop
   exitif mark (none) = end_of (current_buffer);
   spell_range := search (pat1, forward, no_exact);
   if spell_range <> 0 then
      spell_check_range (spell_range);
      if last_key = ctrl_z_key then
         return (1);
      endif;
   endif;
   move_horizontal (-current_offset);
   move_vertical (1);
endloop;

position (end_of (current_buffer));

return (1);

ENDPROCEDURE;

! definitions for the spelling checker
eve$arg1_spell       := 'string';
dictionary$available := 0;
dictionary$buffer    := 0;
default$buffer       := 0;

word_separators      := " "             ! space
                     + ascii (9)        ! horzontal tab
                     + ascii (12)       ! form feed
                     + ascii (13)       ! carriage return
                     + ascii (11)       ! vertical tab
                     + ascii (10);      ! line feed

ENDMODULE;