c====================================================================== c Search Dictionary(s) for A Word c LOGICAL*4 FUNCTION SPELL_CHECK_WORD (WORD_STR, x COMMON_FLAG, x PROJECT_FLAG, x USER_FLAG) c c This routine look in one or more dictionaries for a word. c It return TRUE if it finds it and FALSE if not. c c Parameter Description c c WORD_STR word to be checked c COMMON_FLAG flag indicating use the common dictionary c PROJECT_FLAG flag indicating use the project dictionary c USER_FLAG flag indicating use the user dictionary c c====================================================================== implicit none include 'spell_include' character*(*) word_str integer*4 i,l logical*4 common_flag logical*4 project_flag logical*4 user_flag logical*4 search_common_dictionary logical*4 search_project_dictionary logical*4 search_user_dictionary byte word(word_size) c test word length for dictionary maximum l = len(word_str) if (l.gt.word_size-1) then spell_check_word = .FALSE. return end if c convert word to internal string format and to lowercase word(1) = l do i = 2,l+1 word(i) = ichar(word_str(i-1:1)) if ((word(i).ge.'A').and.(word(i).le.'Z')) x word(i) = word(i) + 32 end do c lookup word in dictionary(s) spell_check_word = .TRUE. if (user_flag) then if (search_user_dictionary(word)) return end if if (project_flag) then if (search_project_dictionary(word)) return end if if (common_flag) then if (search_common_dictionary(word)) return end if spell_check_word = .FALSE. return end c====================================================================== c LOAD THE COMMON DICTIONARY c INTEGER*4 FUNCTION LOAD_COMMON_DICTIONARY c c This routine loads internal data structure(s) with the c the common dictionary index and opens the common dictionary c file for read. An error status code is returned. c c Returned Description c Status c c 0 Error opening common dictionary c 1 Common dictionary available c c====================================================================== implicit none include 'spell_include' c set error return value load_common_dictionary = 0 c read common dictionary index open (unit=8,file='COMMON_DICTIONARY:COMMON.INDEX',err=10, x READONLY,form='UNFORMATTED',recordtype='SEGMENTED', x status='OLD') read (unit=8,err=10) common_ptr_limit,common_buf_limit, x file_ptr,common_ptr,common_buf close(unit=8) c open common dictionary file open (unit=8,file='COMMON_DICTIONARY:COMMON.DICT',err=10, x READONLY,access='DIRECT',organization='RELATIVE', x form='UNFORMATTED',status='OLD') load_common_dictionary = 1 return 10 close (unit=8) return end c====================================================================== c LOAD PROJECT DICTIONARY c INTEGER*4 FUNCTION LOAD_PROJECT_DICTIONARY c c This routine loads internal data structure(s) with the project c dictionary. An error status code is returned. c c Returned Description c Status c c 0 Error opening project dictionary c 1 Project dictionaries available c c====================================================================== implicit none include 'spell_include' c set error return value load_project_dictionary = 0 c load project dictionary open (unit=9,file='PROJECT_DICTIONARY:PROJECT.DICT',err=10, x READONLY,form='UNFORMATTED',recordtype='SEGMENTED', x status='OLD') read (unit=9,err=10) project_ptr_limit,project_buf_limit, x project_ptr,project_buf load_project_dictionary = 1 close (unit=9) return 10 close (unit=9) return end c====================================================================== c LOAD USER DICTIONARY c INTEGER*4 FUNCTION LOAD_USER_DICTIONARY c c This routine loads internal data structure(s) with the user c dictionary. An error status code is returned. c c Returned Description c Status c c 0 Error opening user dictionary c 1 User dictionaries available c c====================================================================== implicit none include 'spell_include' c set error return value load_user_dictionary = 0 c load user dictionary open (unit=9,file='USER_DICTIONARY:USER.DICT',err=10, x READONLY,form='UNFORMATTED',recordtype='SEGMENTED', x status='OLD') read (unit=9,err=10) user_ptr_limit,user_buf_limit, x user_ptr,user_buf load_user_dictionary = 1 close (unit=9) return 10 close (unit=9) return end c======================================================================== c Search The Common Dictionary Index For A Words Dictionary File c Pointer c INTEGER*4 FUNCTION SEARCH_COMMON_DICT_INDEX (WORD,START,END) c c Description c c Using a binary search locate a word in the common dictionary c index data structure(s). If it is equal to the index word return c zero (0) otherwise return the (non-zero) record pointer of the c index word immediately less than the word being tested. The test c word is assumed to be in uppercase. c c Parameter Description c c WORD Word to look up in common dictionary index c START Start of index search area c END End of index search area c c======================================================================== implicit none include 'spell_include' byte word(1) integer*4 i,j,first,last,start,end logical compare_words search_common_dict_index = 0 if (word(1).le.0) return i = compare_words(word,common_buf(common_ptr(start))) if (i.le.0) then if (i.lt.0) search_common_dict_index = start return endif i = compare_words(word,common_buf(common_ptr(end))) if (i.ge.0) then if (i.eq.0) search_common_dict_index = end return end if first = start last = end do while (last-first.gt.1) i = (last+first)/2 j = compare_words(word,common_buf(common_ptr(i))) if (j.eq.0) then return else if (j.gt.0) then first = i else last = i end if end do search_common_dict_index = file_ptr(first) return end c======================================================================== c Search The Common Dictionary For A Word c LOGICAL FUNCTION SEARCH_COMMON_DICTIONARY (WORD) c c Description c c Search the common dictionary for a word. Look in the index for c the word or the file record number of the index word less than c the specified word. If the word is not in the index, search the c dictionary file starting with the index word plus one. Return c TRUE if the word is found and FALSE if not. c c Parameter Description c c WORD Word to look up in the common dictionary c c======================================================================== implicit none include 'spell_include' byte word(1),dict_word(word_size) integer*4 idx,status,compare_words logical search_common_dict_index c set initial value search_common_dictionary = .TRUE. c do binary search of dictionary index idx = search_common_dict_index(word,1,common_ptr_limit) if (idx.eq.0) return c do sequential search of dictionary file starting at idx + 1 10 idx = idx + 1 read(unit=8,rec=idx,err=20) dict_word status = compare_words(word,dict_word) if (status.eq.0) return if (status.gt.0) goto 10 20 search_common_dictionary = .FALSE. return end c======================================================================== c Search Project Dictionary For A Word c LOGICAL FUNCTION SEARCH_PROJECT_DICTIONARY (WORD) c c Description c c Search the project dictionary for a word. If the word is in the c project dictionary return TRUE. Return FALSE if it is not. c c Parameter Description c c WORD Word to look up in the users dictionary c c======================================================================== implicit none include 'spell_include' byte word(1),dict_word(word_size) integer*4 compare_words integer*4 i,j,first,last c initilize and test search_project_dictionary = .FALSE. if (word(1).le.0) return if (project_ptr_limit.le.0) return i = compare_words(word,project_buf(project_ptr(1))) if (i.le.0) then if (i.eq.0) search_project_dictionary = .TRUE. return end if if (project_ptr_limit.eq.1) return i = compare_words(word, x project_buf(project_ptr(project_ptr_limit))) if (i.ge.0) then if (i.eq.0) search_project_dictionary = .TRUE. return end if if (project_ptr_limit.lt.3) return first = 1 last = project_ptr_limit do while (last-first.gt.1) i = (last+first)/2 j = compare_words(word,project_buf(project_ptr(i))) if (j.eq.0) then search_project_dictionary = .TRUE. return else if (j.gt.0) then first = i else last = i end if end do return end c======================================================================== c Search User Dictionary For A Word c LOGICAL FUNCTION SEARCH_USER_DICTIONARY (WORD) c c Description c c Search the users dictionary for a word. If the word is in the c user dictionary return TRUE. Return FALSE if it is not. c c Parameter Description c c WORD Word to look up in the users dictionary c c======================================================================== implicit none include 'spell_include' byte word(1),dict_word(word_size) integer*4 compare_words integer*4 i,j,first,last c initilize and test search_user_dictionary = .FALSE. if (word(1).le.0) return if (user_ptr_limit.le.0) return i= compare_words(word,user_buf(user_ptr(1))) if (i.le.0) then if (i.eq.0) search_user_dictionary = .TRUE. return end if if (user_ptr_limit.eq.1) return i = compare_words(word,user_buf(user_ptr(user_ptr_limit))) if (i.ge.0) then if (i.eq.0) search_user_dictionary = .TRUE. return end if if (user_ptr_limit.lt.3) return first = 1 last = user_ptr_limit do while (last-first.gt.1) i = (last+first)/2 j = compare_words(word,user_buf(user_ptr(i))) if (j.eq.0) then search_user_dictionary = .TRUE. return else if (j.gt.0) then first = i else last = i end if end do return end c======================================================================== c Compare Two Words and Return The Results c INTEGER*4 FUNCTION COMPARE_WORDS (WORD1,WORD2) c c Description c c Compare a two words words. Return zero (0) if the words match. c Return minus one (-1) if WORD1 is less than (lexical comparison) c WORD2 and plus one (+1) if it is greated. The words are assumed c to be the same case. c c Parameter Description c c WORD1 Word to test c WORD2 Word to be tested against c c======================================================================== implicit none include 'spell_include' byte word1(1),word2(2) integer*4 i,j,k,lword1,lword2 c get word lengths lword1 = word1(1) lword2 = word2(1) c lexically compare the words do i = 2,min(lword1,lword2)+1 if (word1(i).ne.word2(i)) then if (word1(i).gt.word2(i)) then COMPARE_WORDS = 1 else COMPARE_WORDS = -1 end if return end if end do if (lword1.eq.lword2) then COMPARE_WORDS = 0 else if (lword1.gt.lword2) then COMPARE_WORDS = 1 else COMPARE_WORDS = -1 end if return end c======================================================================= c INITILIZE USER DICTIONARY DATA STRUCTURE(S) c INTEGER*4 FUNCTION INIT_USER_DICTIONARY c c This routine initializes the internal data strucuture(s) that c hold the user defined dictionary. It empties the data c structure(s). An error status is returned. c c Returned c Status Descriton c c 1 Sucessful completion c c======================================================================= implicit none include 'spell_include' integer*4 i c initilize things do i = 1,user_buf_array_size user_buf(i) = ' ' end do do i = 1,user_ptr_array_size user_ptr(i) = 0 end do user_ptr_limit = 0 user_buf_limit = 0 init_user_dictionary = 1 return end c======================================================================= c WRITE USER DICTIONARY DATA STRUCTURES(S) TO A DISK FILE c INTEGER*4 FUNCTION SAVE_USER_DICTIONARY c c This routine write the user dictionary stored in internal data c structure(s) to a disk file. An error status code is c returned. c c Returned c Status Descriton c c 1 Sucessful completion c 2 Error opening disk file c 3 Error writing disk file c c======================================================================= implicit none include 'spell_include' open (unit=10,file='USER_DICTIONARY:USER.DICT', x form='UNFORMATTED',recordtype='SEGMENTED', x status='UNKNOWN',err=100) write (unit=10,err=110) user_ptr_limit,user_buf_limit, x user_ptr,user_buf close (unit=10) save_user_dictionary = 1 return 100 save_user_dictionary = 2 return 110 close (unit=10) save_user_dictionary = 3 return end c======================================================================= c INSERT WORD INTO USER DICTIONARY DATA STRUCTURE(S) c INTEGER*4 FUNCTION INSERT_WORD_INTO_USER_DICT (STRING) c c This routine inserts a word into the user dictionary stored in c internal data structure(s). An error status code is returned. c c Parameter Description c c STRING Word to be inserted into user dictionary c c Returned c Status Descriton c c 1 Sucessful completion c 2 Word exceeds dictionary word size c 3 Word buffer overflow c 4 Maximum word count exceeded c c======================================================================= implicit none include 'spell_include' character*(*) string integer*4 i,j,k,str_len integer*4 compare_words byte word(word_size) c test minimum word length str_len = len(string) if (str_len.eq.0) then insert_word_into_user_dict = 1 return end if c test maximum word length if (str_len.ge.word_size) then insert_word_into_user_dict = 2 return end if c test for word buffer overflow if ((user_buf_limit+str_len+1).gt.user_buf_array_size) then insert_word_into_user_dict = 3 return end if c test maximum word count if (user_ptr_limit.ge.user_ptr_array_size) then insert_word_into_user_dict = 4 return end if c copy string into word byte buffer and convert it to lowercase word(1) = str_len i = 2 do j = 1,str_len word(i) = ichar(string(j:j)) if ((word(i).ge.'A').and.(word(i).le.'Z')) x word(i) = word(i) + 32 i = i + 1 end do c insert word pointer into uesr dictionary word pointer buffer c in sort order if (user_ptr_limit.eq.0) then ! first word user_ptr_limit = user_ptr_limit + 1 user_ptr(user_ptr_limit) = user_buf_limit + 1 else do i = 1,user_ptr_limit j = compare_words(word,user_buf(user_ptr(i))) if (j.eq.0) then insert_word_into_user_dict = 1 return else if (j.lt.0) then do k = user_ptr_limit,i,-1 user_ptr(k+1) = user_ptr(k) end do user_ptr_limit = user_ptr_limit + 1 ! in middle user_ptr(i) = user_buf_limit + 1 goto 10 endif end do user_ptr_limit = user_ptr_limit + 1 ! last word user_ptr(user_ptr_limit) = user_buf_limit + 1 end if c insert word into dictionary word buffer 10 do i = 1,str_len+1 user_buf_limit = user_buf_limit + 1 user_buf(user_buf_limit) = word(i) end do 20 insert_word_into_user_dict = 1 return end c======================================================================= c RETURN A WORD FROM THE USER DICTIONARY c INTEGER*4 FUNCTION RETURN_USER_DICT_WORD (INDEX,DESC) c c This routine returns a word from the user dictionary. A c VAX/VMS dynamic string descriptor is used and the word c returned through it. An index value determines which word is c returned. An error status code is returned. c c Parameter Description c c INDEX index of the word to be returned c DESC VAX/VMS dynamic string descriptor of returned word c c Returned c Status Descriton c c 0 No word to return c 1 Sucessful completion c c======================================================================= implicit none include 'spell_include' integer*4 i,index,desc,len,status,str$copy_r c test if the word exists return_user_dict_word = 0 if ((index.ge.1).and.(index.le.user_ptr_limit)) then len = user_buf(user_ptr(index)) status = str$copy_r(desc,len,user_buf(user_ptr(index)+1)) if (status) return_user_dict_word = 1 end if return end c======================================================================= c INSERT WORD INTO PROJECT DICTIONARY DATA STRUCTURE(S) c INTEGER*4 FUNCTION INSERT_WORD_INTO_PROJECT_DICT (STRING) c c This routine inserts a word into the project dictionary c stored in internal data structure(s). An error status code is c returned. c c Parameter Description c c STRING Word to be inserted into user dictionary c c Returned c Status Descriton c c 1 Sucessful completion c 2 Word exceeds dictionary word size c 3 Word buffer overflow c 4 Maximum word count exceeded c c======================================================================= implicit none include 'spell_include' character*(*) string integer*4 i,j,k,str_len integer*4 compare_words byte word(word_size) c test minimum word length str_len = len(string) if (str_len.eq.0) then insert_word_into_project_dict = 1 return end if c test maximum word length if (str_len.ge.word_size) then insert_word_into_project_dict = 2 return end if c test for word buffer overflow if ((project_buf_limit+str_len+1).gt. x project_buf_array_size) then insert_word_into_project_dict = 3 return end if c test maximum word count if (project_ptr_limit.ge.project_ptr_array_size) then insert_word_into_project_dict = 4 return end if c copy string into word byte buffer and convert it to lowercase word(1) = str_len i = 2 do j = 1,str_len word(i) = ichar(string(j:j)) if ((word(i).ge.'A').and.(word(i).le.'Z')) x word(i) = word(i) + 32 i = i + 1 end do c insert word pointer into uesr dictionary word pointer buffer c in sort order if (project_ptr_limit.eq.0) then ! first word project_ptr_limit = project_ptr_limit + 1 project_ptr(project_ptr_limit) = project_buf_limit + 1 else do i = 1,project_ptr_limit j = compare_words(word,project_buf(project_ptr(i))) if (j.eq.0) then insert_word_into_project_dict = 1 return else if (j.lt.0) then do k = project_ptr_limit,i,-1 project_ptr(k+1) = project_ptr(k) end do project_ptr_limit = project_ptr_limit + 1 ! in middle project_ptr(i) = project_buf_limit + 1 goto 10 endif end do project_ptr_limit = project_ptr_limit + 1 ! last word project_ptr(project_ptr_limit) = project_buf_limit + 1 end if c insert word into dictionary word buffer 10 do i = 1,str_len+1 project_buf_limit = project_buf_limit + 1 project_buf(project_buf_limit) = word(i) end do 20 insert_word_into_project_dict = 1 return end c======================================================================== c Get The Command Line Parameter c LOGICAL FUNCTION GET_COMMAND_LINE_PARAMETER (LENGTH,PARAM) c c Description c c If the program is a VMS foreign command, extract the parameter(s) c (if any) and return the parameter as a string. A status of TRUE c is returned if a parameter was found. A status of FALSE is c returned if none was found. c c Parameter Description c c LENGTH length of returned string c PARAM Returned parameter string c c======================================================================== implicit none character*80 cmdline character*(*) param integer*4 length,first,last integer*4 sys_status,cmdlength,lib$get_foreign logical locate_parameter c initilize things length = 0 get_command_line_parameter = .FALSE. c get command line (if any) sys_status = lib$get_foreign(cmdline,,cmdlength,) if (.NOT. sys_status) return c get first parameter (if any) first = 1 if (.NOT. locate_parameter(cmdline,first,last)) return get_command_line_parameter = .TRUE. length = last - first + 1 param = cmdline(first:last) return end c======================================================================== c Locate A Parameter Within A String c LOGICAL FUNCTION LOCATE_PARAMETER (STRING,FIRST,LAST) c c Description c c This function returns TRUE if a parameter is found and FALSE if c not. The location within the string of the first and last c A parameter is a series of contiguous non-blank characters c demimited by blank(s). c c Parameter Description c c STRING String to be searched c FIRST Starting location for search and the location of the c first nonblank character of parameter c LAST Location of the last nonblank character of parameter c c======================================================================== implicit none character*(*) string integer*4 first,last integer*4 i,j,l locate_parameter = .FALSE. ! set initial return value l = len(string) ! get string length if (first.gt.l) return ! test end of string do i = first,l ! locate first non-blank char if (string(i:i).ne.' ') goto 10 end do first = i return 10 do j = i,l ! locate last non-blank char if (string(j:j).eq.' ') goto 20 end do 20 first = i ! set return value(s) last = j - 1 locate_parameter = .TRUE. return end c======================================================================== c Locate A Word of Alpha Characters Within A String c LOGICAL FUNCTION LOCATE_ALPHA_WORD (STRING,LENGTH,FIRST,LAST) c c Description c c This function returns TRUE if a word (a series of contiguous c alpha characters) is found. FALSE is returned if not. The c location within the string of the first and last characters of c the word is returned. c c Parameter Description c c STRING String to be searched c LENGTH Length of good data in the string c FIRST Starting location for search and the location of the c first nonblank character of parameter c LAST Location of the last nonblank character of parameter c c======================================================================== implicit none character*(*) string integer*4 length,first,last integer*4 i,j locate_alpha_word = .FALSE. ! set initial return value if (first.gt.length) return ! test end of string do i = first,length ! locate first alpha char if (((string(i:i).ge.'a').and. x (string(i:i).le.'z')).or. x ((string(i:i).ge.'A').and. x (string(i:i).le.'Z'))) goto 10 end do return 10 do j = i,length ! locate last alpha char if (.NOT.(((string(j:j).ge.'a').and. x (string(j:j).le.'z')).or. x ((string(j:j).ge.'A').and. x (string(j:j).le.'Z')))) goto 20 end do 20 first = i ! set return value(s) last = j - 1 locate_alpha_word = .TRUE. return end c======================================================================== c Check The Spelling Of All Of The Words In A Text File c SUBROUTINE SPELL_CHECK_FILE (UNITNUMBER, x COMMON_FLAG, x PROJECT_FLAG, x USER_FLAG) c c Description c c Spell check a text file. Each word found in the text file will c tested to see if it is in the dictionary. Each line if the text c file will be displayed and words not found in the dictionary will c will be indicated. A word is a contiguous set of alpha c characters surrounded by delimeters. c c Parameter Description c c UNITNUMBER FORTRAN I/O unit number c COMMON_FLAG use common dictionary flag c PROJECT_FLAG use project dictionary flag c USER_FLAG use user dictionary flag c c======================================================================== implicit none include 'spell_include.for' character*512 textbuf integer*4 unitnumber integer*4 i,j,textlen,first,last logical*4 common_flag,project_flag,user_flag logical*4 errflag,word_error logical*4 locate_alpha_word logical*4 spell_check_word byte errbuf(512),word(word_size) c read record from text file 10 read (unit=unitnumber,end=100,fmt=1000) textlen,textbuf c blank fill error display buffer, put tabs where they are needed do i = 1,textlen if (textbuf(i:i) .eq. char(9)) then errbuf(i) = 9 ! tab else errbuf(i) = ' ' ! blank end if end do c turn off error display errflag = .FALSE. c spell check all the words in the text record first = 1 do while (locate_alpha_word(textbuf,textlen,first,last)) word_error = .TRUE. if (last-first+1.lt.word_size-1) then if (spell_check_word(textbuf(first:last), x common_flag, x project_flag, x user_flag)) x word_error = .FALSE. end if c fill error buffer if appropriate if (word_error) then errflag = .TRUE. do i = first,last errbuf(i) = '*' end do end if first = last + 1 end do write(*,1010) textbuf(1:textlen) if (errflag) write (*,1020) (errbuf(i),i=1,textlen) goto 10 100 return 1000 format (q,a) 1010 format (1x,a) 1020 format (1x,a) end