c. This prgram; is mant to act- as an OnLine Diionary for c. the "legal" spelling, or words.It looks up the input word in its c. 35,000 word dictionary. Don't Check: Words starting with Non alpha, c. Single character words, Trailing punctuation. c.--------------------------------------------------------------------- c.Cmd---v c. Out_file .. Resulting output c. /EDIT .. Edit the current "Old_file" c. /EDT .. Edt the current "Old_file" c. EXIT .. Exit {after processing IN_file} c. $ Cmd .. Issue the DCL command c. -B .. Output a Bell on errors c. -L .. Output each word on a Separate line c. -P .. Pack the words together {if not -L} c. -U .. Show multiple occur of Unique bad words c. -W .. Return the "LEGAL" words in a list format c. .. otherwise, use interactive mode for on-line correcting. c. -T .. Output text format with incorrect words flagged c-----------------------------------------------------------end.of.info c. -D .. Debug c. /ZERO .. Clear good and bad c.----------------------------------------------------------------------- c. Words checked by this program must have the following c. characteristics: c. -start with an alpha character, "a" to "z"; c. -be of length less than 20 chatacters; c. -if a word ends in "'s", the possessive form checked; c. -hyphenated words are evaluated as two separate words; c. -trailing delimitors are eliminated; c. -words that are entirely in CAPS are not checked unless c. the "-C" switch is specified; c. -words beginning with a period are not checked unless c. the "-P" switch is specified,(this allows the spelling c. program to be used in conjunction with Runoff). c.---------------------------------------------------------------------- c. c CALLS JJCTC .. to set and read control C's c. CALLS JJUCMD .. to read the commands c CALLS IOPEN .. to open the units c. c.--------------------------------------------------------------------- c. COMMON /JJU_SWI/ JJUS(256) COMMON / JJU_FIL / infile, outfile COMMON / OUTDEV / idev, interflg, icount character*80 infile, outfile character*32 cmd, chread, chtem, ian, cmd1, cmd2 character*80 inline, ch1, ch2, oldfile, savlin(3), blklin character*80 curlin, prtlin, inlin2 integer numch(32) integer lunopn(20) !! Set 1 if open character*32200 bad character*32200 good character*4 quest c data good(1:10)/' '/,ixg/1/ data bad(1:10)/' '/,ixb/1/ data quest / ' ? ' / data blklin(1:10) / ' ' / c.------------------------------------------------ 41 format(80a) 42 format(' ',/////) 43 format(' ?',$) c.------------------------------------------------ c ...set up to trap ctrl-c call jjctc(1) c call LIB$ERASE_PAGE(1,1) call LIB$SET_CURSOR(1,1) c c ... Initalize with "NO_FILE" c. 500 continue savlin(1)=blklin savlin(2)=blklin savlin(3)=blklin curlin=blklin itim=0 if( isexit.eq.1 ) goto 9000 c ... Flush the buffer call OUTWRD('\N') c ... Close input unit close(unit=1) ch1 = ' ' ch2 = ' 0 when files are currently open c ... Get the next word in the cmd line.jjjnxt=# chars. c ... Or,read in a new line, leaving 1st space blank c ... put next word from inline to cmd; move that word out c ... of inline. c ... On return jjucmd= { >0 : # characters; c =0 : EOL; c =-1 : EO@; c =-2 : ^Z c. 2000 continue newflg=0 2010 interflg=0 if( isinfl.gt.0 ) then if( jjjnxt( cmd, inline ).gt.0 ) goto 2300 read( 1,41,end=500) inline(2:) inlin2(1:)=inline(2:) newflg=1 goto 2010 else call JJUpp(cmd) idev=6 if(JJUS(ichar('W')).ge.0) idev=-2 if( jjucmd( cmd, inline ) ) 9000, 2100, 2200 endif c. 2100 continue if( infile.eq.' NO_FILE' ) goto 1000 if( infile.eq.' *' ) then infile = oldfile else oldfile = infile endif inline = ' ' iret = JJUFIL( ch1, ch2 ) if( iret.le.0 ) goto 500 isinfl = +1 ixb = 1 numb = 0 goto 2000 c.------------------------------------------------------------- c... User only commands c. 2200 continue if( cmd(1:1).eq.'?' .or. cmd.eq.'HELP' ) then if( numg+numb.gt.0 ) 1 type *,' ',numg+numb,' Unique words', numb,' Bad' if( JJUS(ichar('D')).lt.0 ) 1 type *,ixg, ' Size of Good',ixb,' Size of Bad' type *,'Word? {Cmd} {Out_file}' type *,' {Word} {aaaaa} {aa...{bb}} {aa?bb}' type *,' {Flags} {-Line} {-Pack}' type *,' {Other} {/EDIT} {/EDT} {$ dcl_cmd} {EXIT}' if( oldfile(2:).gt.' ' ) 1 type *,' {Lst <*} <',Oldfile(2:jjlen(oldfile)) goto 1000 else if(cmd(1:1).eq.'=' ) then open(unit=1,name=inline(2:),type='old',err=1000) type *,' Reading ',inline(1:jjlen(inline)) 2311 continue read(1,41,end=2312)inline lnl = jjlen(inline) call jjlow(inline(1:lnl)) good(ixg+1:ixg+lnl+4) = inline ixg = ixg+lnl+2 goto 2311 2312 continue close(unit=1) goto 1000 else if(cmd.eq.'/EDT' ) then call lib$spawn('EDIT/EDT/Command=SCI_COM:EDTINI '//oldfile) goto 1000 else if( cmd.eq.'/ZERO' ) then type *,ixg,' Siz of Good',ixb,' Siz of Bad, ZEROED' ixb = 1 ixg = 1 numg = 0 numb = 0 goto 1000 else if(cmd(1:1).eq.'/' ) then call LIB$SPAWN( cmd(2:jjlen(cmd))//' '//oldfile ) goto 1000 else if( cmd.eq.'EXIT' ) then isexit = 1 if( infile.eq.' NO_FILE' ) goto 9000 goto 2000 endif c.---------------------------------------------------------------- c... O.K. not a User command c. 2300 continue if(newflg.ne.1) goto 2310 c ...if a new line of text was just read then, c ... if this is interactive mode, save the last line c ... if this is the output text mode, write the last line c ...reset the newflg to zero. if(JJUS(ichar('W')).ge.0) then savlin(1)=savlin(2) savlin(2)=savlin(3) savlin(3)=curlin endif c if(((JJUS(ichar('T')).lt.0).or.(JJUS(ichar('W')).ge.0)) * .and.(itim.gt.0)) then do ln4=80,1,-1 if(curlin(ln4:ln4).gt.' ') goto 52 enddo if(ln4.lt.1) goto 55 52 write(6,41) curlin(1:ln4) endif c 55 if((JJUS(ichar('W')).lt.0).or.(itim.ne.0)) goto 2305 do 50 i=1,60,5 prtlin(i:i+4)='-----' 50 continue call LIB$ERASE_PAGE(1,1) call LIB$PUT_SCREEN(prtlin,9,1) call LIB$SET_SCROLL(10,24) call LIB$SET_CURSOR(1,1) c. 2305 itim=1 curlin=inlin2 newflg=0 c 2310 if( jjctc(0).gt.0 ) then type 41,' Enter: ^Z to exit',07 goto 1500 endif c ... make all lower case cmd1=cmd call JJUpp(cmd) call jjlow(cmd) C ... ln=length of the cmd word ln = jjlen(cmd) c ... 1st letter in the word must be an alpha if( cmd(1:1).lt.'a' .or. cmd(1:1).gt.'z' ) goto 2000 c ... length of the word must be <20 characters. if( ln.ge.20 ) goto 2000 c ... This is to look up the spelling of a user entered c ... word in the dictionary.isinfl=0;no input document. if( isinfl.le.0 ) then if( index(cmd,'...').ne.0 ) goto 4000 !! aaaa... if( index(cmd,'?').ne.0 ) goto 3000 !! aa?bb endif c ... Find the last alpha character;this gets rid of c ... blanks,commas,periods and other delimiters. do ln=ln,1,-1 if( cmd(ln:ln).ge.'a'.and.cmd(ln:ln).le.'z' ) goto 2500 enddo goto 2000 c ... Checking a word from an input document. c ... If "'s" ---strip it. 2500 continue if(ln.le.2) goto 2505 if( cmd(ln-1:ln).eq.'''s' ) ln = ln-2 c ... Evaluate hyphenated words or words w/ periods c ... as two separate words. Alter inline accordingly. 2505 do ii=ln,1,-1 if( cmd(ii:ii).eq.'.' .or. cmd(ii:ii).eq.'-' ) then inline(ii:ii) = ' ' cmd(ii:) = ' ' ln = ii-1 endif enddo c ... If word is just one letter, dont check.continue. if( ln.le.1 ) goto 2000 c. ... Is the word already in the array of "good" words? if( index(good(1:ixg),' '//cmd(1:ln)//' ').ne.0 ) goto 2650 c ... Has the word already been tagged as a bad word? c ... If so, and there is an input document and the "U" c ... option was chosen, dont print it again. continue. if( index(bad(1:ixb),' '//cmd(1:ln)//' ').ne.0 ) then if( isinfl.gt.0 .and. JJUS(ichar('U')).ge.0 ) goto 2000 goto 2770 endif c ... Has the isam dictionary file for words of this c ... length been opened yet? if( lunopn(ln).eq.0 ) lunopn(ln) = IOPEN( ln ) c ... try to do an index read of keyeq=equal for the word c ... If the word isnt in the dictionary,goto 2750;its bad c ... If its found,add it to the list of found good words. read(50+ln,41,keyeq=cmd(1:ln),err=2750) chread numg = numg+1 if( ixg.le.32000 ) then good(ixg+1:ixg+ln+4) = ' '//cmd(1:ln) ixg = ixg+ln+2 if(JJUS(ichar('D')).lt.0 ) type *,ixg,' Good' endif 2650 continue c ... If checking a user entered single word; print ok. if( isinfl.le.0 ) then write(6,41)' Ok `',cmd(1:ln),'''' endif goto 2000 c c. ----------------------------------------------------------- c ... Word wasnt in the dictionary. 2750 continue numb = numb+1 c ... Add word to the list of found bad words.limit=32000 if( ixb.lt.32000 ) then bad(ixb+1:ixb+ln+4)=' '//cmd(1:ln) ixb = ixb+ln+2 if(JJUS(ichar('D')).lt.0 ) type *,ixb,' Bad' endif 2770 continue interflg=0 c ... if this is output text mode, flag the word. if(JJUS(ichar('T')).lt.0) goto 2900 c ... if this is interactive, get user input to correct it if(JJUS(ichar('W')).ge.0) goto 2800 c ... If checking user entered single words;tell user c ... its not spelled correctly. if( isinfl.le.0 ) then write(6,41)' `',cmd(1:ln),''' *NO*' else c ... If the 'b' switch is used, ring bell; output to list if( JJUS(ichar('B')).lt.0 ) type 41,'+',07 if( ln.ge.20 ) ln = 19 call OUTWRD( cmd(1:ln) ) endif goto 2000 c------------------------------------------------------------------ c ... Interactive correction mode c ... clear the screen;write out the last three lines; c ...ask for user response to correct the word c 2800 call LIB$ERASE_PAGE(10,1) 2810 call LIB$SET_CURSOR(1,1) cmd=cmd1 ln=jjlen(cmd) nlc=index(curlin,cmd(1:ln)) interflg=1 ian=cmd i=4 j=1 call LIB$ERASE_LINE(i,1) call LIB$ERASE_LINE(i+1,1) call LIB$ERASE_LINE(i+2,1) call LIB$PUT_SCREEN(savlin(2),i,j) call LIB$PUT_SCREEN(savlin(3),i+1,j) call LIB$SET_CURSOR(i+2,1) if(nlc.gt.1) call LIB$PUT_SCREEN(curlin(1:nlc-1),i+2,j) call LIB$PUT_SCREEN(cmd(1:ln),,,2) call LIB$PUT_SCREEN(curlin(nlc+ln:)) 2820 call LIB$ERASE_LINE(i+4,1) call LIB$SET_CURSOR(i+4,1) call LIB$GET_SCREEN(cmd,quest,ln2) call LIB$SET_CURSOR(11,1) c cmd2=cmd call JJUPP(cmd) call JJLOW(cmd) if(index(cmd,'...').ne.0) goto 4000 if(index(cmd,'?' ).ne.0) goto 3000 if(index(cmd,'=' ).ne.0) goto 8000 if(cmd(1:1).eq.' ') goto 2850 if((cmd(1:1).gt.'0').and.(cmd(1:1).le.'9')) then interflg=9 call outwrd(cmd2) endif cmd=cmd2 ln1=JJLEN(cmd) curlin(nlc:)=cmd(1:ln1)//curlin(nlc+ln:) inline(1:)=' '//cmd(1:ln1)//inline(ln+1:) interflg=0 if(jjjnxt( cmd, inline ) .gt. 0) goto 2300 c 2850 call LIB$ERASE_PAGE(11,1) goto 2000 c------------------------------------------------------------------ c ... Output text with the incorrect word flagged c 2900 loc=1 cmd=cmd1 ln=jjlen(cmd) 2910 nlc=index(curlin(loc:),cmd(1:ln)) in=index(curlin(loc:),' ?> ') if(in.eq.0) goto 2912 if(in.ne.nlc-4) goto 2912 loc=nlc+1 goto 2910 c ... Find the last alpha character;this gets rid of c ... blanks,commas,periods and other delimiters. 2912 do ln3=80,1,-1 if( curlin(ln3:ln3).gt.' ') goto 2915 enddo 2915 if(ln3.le.76) goto 2920 if(nlc.gt.1) then write(6,41) curlin(1:nlc-1) curlin(1:)=curlin(nlc:80) loc=1 goto 2910 endif if(nlc.eq.1) then write(6,41) ' ?> '//curlin(1:ln) curlin(1:)=curlin(ln+1:80-ln) goto 2000 endif 2920 curlin(nlc:)=' ?> '//curlin(nlc:76) goto 2000 c.----------------------------------------------------------------- c... Test for questional spellings c. 3000 continue if( lunopn(ln).eq.0 ) lunopn(ln) = IOPEN( ln ) chtem = cmd inx = index(cmd,'?') c. c ... Zero the count of bad words. call outwrd('\Z') c ...one char. missing of format aaa?aaa.fill in w/ a to z do ix='a','z' cmd(inx:inx) = char(ix) if( jjctc(0).gt.0 ) goto 1000 read(50+ln,41,keyeq=cmd(1:ln),err=3900)chread call outwrd(chread(1:ln)//',') 3900 continue enddo call outwrd('<----End') c ... Flush buffer call outwrd('\N') if(interflg.ne.1) goto 2000 cmd=ian goto 2820 c.------------------------------------------------------------------- c... test for continuations c. 4000 continue c ... Init. the output buffer call outwrd('\Z') ldot = index(cmd,'...')-1 if( ldot.lt.1 ) then type *,'Can''t have Dot''s at start' goto 2000 endif chtem = cmd(1:ldot) ch2 = cmd(ldot+4:) ltrl = jjlen(ch2) if( ch2.le.' ' ) ltrl = 0 c ... Going to do the set of possible word lengths c ... Go from the file of shortest possible words to long. do ltst=ldot+ltrl, 20-ltrl c ... If ctrl-c, stop list. if( jjctc(0).gt.0 ) goto 1000 if( lunopn(ltst).eq.0 ) lunopn(ltst) = IOPEN( ltst ) c ... Read the prefix part; aaa_ read(50+ltst,41,keyge=chtem(1:ltst),err=4900) chread goto 4500 c. 4100 continue if( jjctc(0).gt.0 ) goto 1000 read(50+ltst,41,end=4900) chread c. 4500 continue if( chread(1:ldot).eq.chtem ) then if( ltrl.eq.0 ) goto 4600 if(chread(ltst-ltrl+1:ltst).ne.ch2) goto 4100 4600 continue call outwrd( chread(1:ltst)//',' ) goto 4100 endif 4900 continue enddo c ... Flush buffer and return for another user command call outwrd('<----End') call outwrd('\N') if(interflg.ne.1) goto 2000 cmd=ian goto 2820 c.---------------------------------------------------------------- c... Segment to create dictionary c. 8000 continue read(1,41,end=9000)cmd n = jjlen(cmd) numch(n) = numch(n)+1 iun = 50+n write(iun,41) cmd(1:n) if(JJUS(ichar('W')).ge.0) goto 2000 goto 2000 c. 9000 continue call OUTWRD('\N') type *,numg+numb,' Unique words', numb,' Bad' if( JJUS(ichar('D')).lt.0 ) 1 type *,ixg,' Siz of Good',ixb,' Siz of Bad' end FUNCTION IOPEN( iunit ) c. Check and Open if necessary, UNIT=50+iunit c. c-------------------------------------------------------------------- integer lunopn(20) !! Set 1 if open character*2 fname character*60 fdir integer JPILIST(4) data JPILIST(1)/'02070040'x/ !!Get exe dir c. c...... if( lunopn(iunit).eq.0 ) then !! Unit not open yet lunopn(iunit) = 1 if( fdir.le.' ' ) then !! Find Directory of WORD JPILIST(2) = %LOC( fdir ) call SYS$GETJPI(,,,JPILIST,,,) inx = index(fdir,']') fdir(inx+1:) = 'WORDS.L' endif write(fname,110)iunit 110 format(i2.2) open(unit=50+iunit,name=fdir//fname,type='OLD',readonly 1 ,carriagecontrol='list' 1 ,organization='indexed' 1 ,form='formatted',recordtype='variable' 1 ,recl=iunit 1 ,access='keyed',key=(1:iunit:character) ) c. endif c. IOPEN = 1 return end SUBROUTINE OUTWRD( cmd ) c. Output a "word" c. c.Inp cmd .. Word, or \Z, or \N c.Uses JJUSWI('L') .. Force each word on a line c. JJUSWI('P') .. Pack the words c. c.Assume... That the files with the Indexed words are in the c. directory under which this program EXECUTES, and have names: c. "WORDS.Lnn", where nn is the Length of the word. c. c.Note.. These are Created, from a sequentual list of the c. words by the program WORDMAKE, and words are Added, Tested, c. or Deleted by the program WORDADD. c-------------------------------------------------------------------- common /JJU_SWI/ JJUS(256) common / OUTDEV / idev, intflg, icnt character*(*) cmd character*80 line character*4 iscnt c character*20 isaw(1000) 41 format(132a) 55 format(i4) 53 format(i3) 52 format(i2) 51 format(i1) c...... if(intflg.eq.9) goto 100 iscnt=' ' if( cmd.eq.'\Z' ) then inx = 0 call LIB$ERASE_PAGE(10,1) icnt=0 else if( cmd.eq.'\N' ) then if( inx.gt.0 ) write(idev,41) ' ',line(1:inx) inx = 0 ibig=icnt icnt=0 else ln = jjlen(cmd) if( inx+ln+4.gt.80 ) then write (idev,41) ' ',line(1:inx) inx = 0 endif icnt=icnt+1 if(cmd(1:1).eq.'<') goto 40 if(icnt.gt.99) write(iscnt(1:3),53) icnt if((icnt.gt.9).and.(icnt.lt.100)) write(iscnt(1:2),52) icnt if(icnt.lt.10) write(iscnt(1:1),51) icnt if(intflg.ne.1) line(inx+1:) = cmd 40 if(intflg.eq.1) line(inx+1:) = iscnt//cmd call jjupp(line(inx+1:inx+1)) if(icnt.ge.1000) goto 50 isaw(icnt)=' ' isaw(icnt)=cmd 50 if( JJUS(ichar('L')).lt.0 ) then write(idev,41) ' ',line(1:inx+1+ln) inx = 0 else if( JJUS(ichar('P')).lt.0 ) then inx = inx+ln+2 else inx = inx+20+(4*intflg) endif endif goto 1000 c 100 ln=jjlen(cmd) read(cmd(1:ln),53) icnt if(ibig.le.icnt) goto 1000 if((icnt.lt.1).or.(icnt.gt.999)) goto 1000 do ln1=20,1,-1 if(isaw(icnt)(ln1:ln1).gt.',') goto 110 enddo 110 cmd(1:ln1)=isaw(icnt)(1:ln1) c. 1000 return end FUNCTION JJJNXT( upcmd, cmd ) c. Get the next word from the Command line c. c.out JJJNXT -- Number of chars in word, 0:No-more c.out UPCMD -- UPPERCASED next word c.I/O CMD -- The Inital, and final command line c---------------------------------------------------------end.of.info character*(*) upcmd, cmd c. c/// Eat up LEAD word c. JJJNXT = 0 upcmd = ' ' do while( cmd(1:1).gt.' ' ) cmd = cmd(2:) enddo c. if( cmd.eq.' ' ) goto 9000 c. do while( cmd(1:1).le.' ' ) cmd = cmd(2:) if( cmd.eq.' ' ) goto 9000 enddo c. c/// Find end of word c. do JJJNXT=2,len(cmd)-1 if( cmd(JJJNXT:JJJNXT).le.' ' ) goto 1900 enddo 1900 continue upcmd = cmd(1:JJJNXT-1) c. call JJUpp(upcmd) c. 9000 continue return end