[IDENT('18JN92'), INHERIT('sys$library:starlet', 'sys$library:pascal$lib_routines', 'sys$library:pascal$smg_routines')] PROGRAM Spell (document, commonfile, persdict, dict1, dict2, dict3, listing, goodfile, logfile, bannerfile, guidanceFile, output); { ****************************************************************************** * * * SPELL Program * * ***** ******* * * * * Version: 2.2-1 * * * * Revision Date: 23-MAY-1985 * * * * Written by: Mark Resmer - Academic Computer Center Manager * * Box 248 * * Vassar College * * Poughkeepsie * * NY 12601 * * * * (914) 452-7000 Ext 2437 * * * * (RESMER@VASSAR on BITnet or CCnet) * * * * Based on: PROOFREAD program written by Matthew Temple * * Smith College, Northampton Mass. His ideas * * and permission to use them are gratefully * * acknowledged. * * * * Language: PASCAL version 3.0 * * * * Operating System: VMS version 4.1 * * * * Copyright (C) 1985 Mark Resmer - permission is hereby granted for the * * reproduction of this software, on condition that this copyright notice * * is included in the reproduction, and that such reproduction is not for * * purposes of profit or material gain. * * * * v2.1 Robin Fairbairns, Laser-Scan, Cambridge, UK * * Incorporates most Laser-Scan improvements to v1, plus * * balanced-binary-tree based sorting of the IgnoreList * * v2.2 Robin Fairbairns, Laser-Scan * * Added improved TeX/LaTeX syntax checking (following tips from * * Earle Ake of SAIC) and asynchronous `guess' operation * * v2.2-1 Robin Fairbairns, Laser-Scan * * Incorporating recommendations (and bug mends) following \beta test * * * ****************************************************************************** } LABEL 99; {panic button} CONST version='2.2'; sys_uic=8; screen_rows=24; screen_cols=80; NumberOfWords = 203; {common words} Maxword = 32; {word length} MaxLine = maxword+255; {line length} cli$_present =%X'0003fd19';{VMS CLI parameter flag} cli$_negated =%X'000381f8';{Ditto....} cli$_absent =%X'000381f0'; cli$_normal =%X'00030001'; pdfile = 'persdict.dat'; {filename for personal dictionary} gdfile = 'newgood.file_name'; {filename for new good word dictionary} filedir = 'spell_dict:'; {logical for master dictionaries} help_logical='spell_help:';{and for help files} ast_mask=(2**3)+(2**23)+(2**25); {trap ^C, ^W and ^Y} max_tree_depth = 60; {maximum acceptable tree depth} ctrl_c=chr(3); ctrl_w=chr(23); ctrl_y=chr(25); line_break_flag = '`'; {the diamond?} line_break_flag_len = 1; TYPE unsigned_word = [WORD]0..65535; {for all sorts of odds and ends} wordtype = VARYING [maxword] OF CHAR; {word format} Line = VARYING [MaxLine] OF CHAR; {line format} clisym = PACKED ARRAY[1..5] OF CHAR; {token names for CLI} linefix = PACKED ARRAY [1..80] OF CHAR; {fixed length string} Word1 = RECORD {short words} item:[key(0)]PACKED ARRAY [1..8] OF CHAR END; Word2 = RECORD {medium words} item:[key(0)]PACKED ARRAY [1..16] OF CHAR END; Word3 = RECORD {long words} item:[key(0)]PACKED ARRAY [1..32] OF CHAR END; Word3s = RECORD {long words with statistics} item:[key(0)]PACKED ARRAY [1..32] OF CHAR; user:PACKED ARRAY [1..32] OF CHAR; {[s]he who put this word into the goodfile} date:PACKED ARRAY [1..23] OF CHAR; {when the deed was done} fnam:PACKED ARRAY [1..32] OF CHAR; {the file it came from} END; BalanceFactor = -1..1; {(experimental) balance state} Tree = ^Leaf; {tree for word storage} Leaf = RECORD Name: wordtype; Left,Right: Tree; SerialNo: INTEGER; Balance: BalanceFactor; END; listptr = ^list; {list for text storage} list = RECORD Name: wordtype; {text of word} next: listptr; {pointer to next element} startpos:INTEGER; {position in line} length:INTEGER; {length of unaltered word} END; DoubleTree = ^DoubleLeaf; {tree for corrected words} DoubleLeaf = RECORD FirstWord,SecondWord: wordtype; Left,Right: DoubleTree END; commontype = ARRAY [1..NumberOfWords] OF PACKED ARRAY [1..32] OF CHAR;{array for common words} esctype = (runoff,scribe,tex,issue,nroff,vaxdoc,unknown); {known word-processors} mainttype = (normal,personal,checking,system); {maint mode flags} param_type = PACKED ARRAY [1..12]OF CHAR; wrd = [WORD]-32768..32767; keystroke = RECORD CASE BOOLEAN OF true: (ch : CHAR); false: (term_code : unsigned_word); END; addr_arr = ARRAY [1..2] OF unsigned; unsafe_text= [unsafe] TEXT; ptr_to_rab = ^rab$type; VAR CommonFile : TEXT; {File of the most common words} Document : unsafe_text; {The thing we are checking} Listing : [VOLATILE]TEXT; {The revised version} using_listing : BOOLEAN:=true; {set FALSE by /NOOUTPUT switch} named_listing : BOOLEAN:=false; {set TRUE by /OUTPUT=fn} work_file:line; {name of of the work (listing) file} every_word_ok : BOOLEAN:=false; {set TRUE by /BUILD switch} do_single_letter_words : BOOLEAN:=false; {set TRUE by /SINGLE switch} Logfile : TEXT; {Optional log file} logging:BOOLEAN:=false; {logging option flag} logged_something:BOOLEAN:=false; {put something in the file} test_version:BOOLEAN:=true; {edit to false for running version - controls debug info on log file} test_run:BOOLEAN:=false; {reflects qualifier TEST} Bannerfile: TEXT; {Help file} guidanceFile : TEXT; {file of guidance information} guidanceNeeded : BOOLEAN:=false; {from /GUIDE switch} guidanceOpen : BOOLEAN:=false; {/GUIDE given, open for writing output} namedGuidanceFile : BOOLEAN:=false; {/GUIDE had a value} guidanceFileName : line; {name of guidance file} Dict1 : [unsafe] FILE OF word1; {short word dictionary} Dict2 : [unsafe] FILE OF word2; {medium word distionary} Dict3 : [unsafe] FILE OF word3; {long word dictionary} dict1_rab : ptr_to_rab; { RABs for the above } dict2_rab : ptr_to_rab; { ... } dict3_rab : ptr_to_rab; { ... } Goodfile : FILE OF word3s; {list of unchecked "right" words} goodfile_rab : ptr_to_rab; { RAB for that } Persdict : FILE OF word3; {personal dictionary} persdict_rab : ptr_to_rab; {and (last but not least) RAB for that} using_persdict : BOOLEAN:=true; {set false by /NOPERSONAL switch} main_ok_chars : SET OF CHAR; {characters acceptable in main menu} NewGoodWords : tree; {words marked as "right"} IgnoreList : tree; {words to ignore} Misspelled : Doubletree; {wrong words and corrections} Textline : listptr; {current line broken into words} Currline,prevline:line; {raw text of current and last lines} First_tmp : Word3s; {initial word for calling WriteTree} LineNumber: INTEGER; {current line count} wordcount:INTEGER:=0; {current word count} errorcount:INTEGER:=0; {current error count} lettertotal:INTEGER:=0; {current letter count} Quit : BOOLEAN; {flag to quit} ThisWord:wordtype; {text of a word} CorrectWord :wordtype; {a corrected word} CommonWordList : commontype; {array of common words} escapemode : esctype := unknown; {what word processor are we using} cmd_index, cmd_lastnb : INTEGER; {used finding end of command line} cmdline:linefix; {the entire command line} param:linefix; {VMS command line parameter} maintmode:mainttype:=normal; {operating mode (default is spell)} filnam:line; {filename to process} usable_file_name:line; {"external" version of filnam} file_name_len:INTEGER; {effective length of usable_file_name} trim_file:linefix; {trimmed filename} dev:line; {name of device/directory} print_tree_flags : ARRAY [1..max_tree_depth] OF BalanceFactor; {shows how one got to where one is} tree_serial_no : INTEGER:=0; {counts entries in balanced trees} document_size : REAL; {`byte number' of FFB in EBK} document_is_open : BOOLEAN:=false; {whether or no document is open} pasteboard:[VOLATILE]unsigned; keyboard:[VOLATILE]unsigned; context_display:unsigned; error_display:unsigned; header_display:unsigned; help_display:unsigned; message_display:unsigned; menu_display:[VOLATILE]unsigned; guess_display:unsigned; {SMG display for guess selection} personal_display:unsigned; status_display:unsigned; top_display:[VOLATILE]unsigned; gigi:BOOLEAN; stat:INTEGER; upper_casing:[VOLATILE]BOOLEAN:=true; {controls behaviour of getkey} selection:keystroke; pasted:BOOLEAN; grp: [VOLATILE] INTEGER; had_unsol_input : [VOLATILE] BOOLEAN; {TRUE if unsolicited input has been received} NextLineTeXescape : BOOLEAN := FALSE; {TRUE=>still in (e.g.) \documentstyle at end of previous line} NextLineVAXDocArg : BOOLEAN := FALSE; {TRUE=>still in VAXDoc argument at end of previous line} currline_row : INTEGER := 3; {where lines appear in the context } prevline_row : INTEGER := 2; { virtual display} alphabetic_chars : SET OF CHAR := ['A'..'Z','a'..'z','Á'..'Ï','Ñ'..'Ý', 'ß','á'..'ï','ñ'..'ý']; upper_case_chars : SET OF CHAR := ['A'..'Z','Á'..'Ï','Ñ'..'Ý']; lower_case_chars : [VOLATILE] SET OF CHAR := ['a'..'z','á'..'ï','ñ'..'ý']; {actually, this is a read-only set, but it's referred to by ASYNCHRONOUS routine getkey, so has to be volatile: perhaps all these ought to be CONSTs?} all_lower_case : SET OF CHAR := ['a'..'z','ß','á'..'ï','ñ'..'ý']; [asynchronous,EXTERNAL(lib$spawn)] FUNCTION do_dcl(%STDESCR cmd:linefix):INTEGER;EXTERNAL; {execute a VMS command} [EXTERNAL] PROCEDURE Spell_CLItable;EXTERNAL; [asynchronous,EXTERNAL] FUNCTION cli$dcl_parse(%STDESCR command:PACKED ARRAY[a..b:INTEGER]OF CHAR; PROCEDURE Spell_CLItable; %REF param_r:INTEGER:=%IMMED 0; %REF prompt_r:INTEGER:=%IMMED 0; %REF prompt_s:INTEGER:=%IMMED 0):INTEGER;EXTERNAL; [asynchronous,EXTERNAL] FUNCTION cli$present(%STDESCR param:clisym):INTEGER;EXTERNAL; [asynchronous,EXTERNAL] FUNCTION cli$get_value(%STDESCR param: clisym; %STDESCR retval: linefix):INTEGER;EXTERNAL; FUNCTION pas$rab ( VAR f : unsafe_text ) : ptr_to_rab; EXTERNAL; { ================================================================================ } FUNCTION open_document ( VAR fab : fab$type; VAR rab : rab$type; VAR f : TEXT) : INTEGER; TYPE pxab = RECORD CASE INTEGER OF 0: (u: unsigned); 1: (x: ^xab$type); END; VAR status : INTEGER; (* Status return from the function *) xab : pxab; (* a XAB to hold the file header guff *) BEGIN xab.u := fab.fab$l_xab; IF xab.u=0 THEN BEGIN (* no XABs at all *) new(xab.x); (* get one *) fab.fab$l_xab:=xab.u; (* point to it from FAB *) xab.x^.xab$l_nxt:=0; (* null forward chain *) xab.x^.xab$b_cod:=xab$c_fhc; (* define `file header characteristic *) END ELSE BEGIN WHILE xab.x^.xab$b_cod<>xab$c_fhc DO BEGIN (* this one isn't the FHC XAB *) IF xab.x^.xab$l_nxt=0 THEN BEGIN (* and there isn't any other *) new(xab.x); (* get another one *) xab.x^.xab$l_nxt:=fab.fab$l_xab; (* chain to head *) fab.fab$l_xab:=xab.u; xab.x^.xab$b_cod:=xab$c_fhc; (* define `file header characteristic *) END ELSE xab.u:=xab.x^.xab$l_nxt; (* follow chain of XABs *) END; END; status := $open(fab); IF odd(status) THEN status := $connect(rab); IF odd(status) THEN BEGIN document_size:=(xab.x^.xab$l_ebk-1)*512.0+xab.x^.xab$w_ffb; document_is_open:=true; END; open_document := status; (* return result of operation *) END; FUNCTION current_document_position : INTEGER; (* returns the position (defined by rfa0, rfa4 in document_rab) *) VAR position : INTEGER; document_rab : ptr_to_rab; {RAB of document} BEGIN IF document_is_open THEN BEGIN document_rab:=pas$rab(document); position := round(((document_rab^.rab$l_rfa0-1)*512.0+ document_rab^.rab$w_rfa4)*100.0/document_size); IF position<0 THEN position:=100; END ELSE position:=-1; current_document_position := position; END; { ================================================================================ } PROCEDURE get_uic; {obtain and set UIC} VAR items: [VOLATILE] RECORD {getjpi descriptor} length: unsigned_word; code : unsigned_word; adr : ^INTEGER; junk : INTEGER; END; BEGIN items.length:=4; {set JPI descriptors} items.code:=jpi$_grp; items.adr:=address(grp); $getjpi(itmlst:=items); {get the group number} END; { =============================================================================== } [asynchronous]FUNCTION getkey: keystroke; VAR key : keystroke; read_return : INTEGER; BEGIN REPEAT read_return := smg$read_keystroke(keyboard,key.term_code); UNTIL ((read_return<>ss$_cancel) AND (read_return<>ss$_abort)); (* this check was inserted to find the bug whereby the system would fail to wait for a response about broadcast messages. Turns out that, despite cancelling any previous input before asking for their own, these routines still fail by virtue of the fact that they would otherwise multi-thread the SMG keyboard input routines (presumably the non-AST code has to run to completion, despite having been cancelled) if (not(odd(read_return))) then lib$signal(read_return); *) IF key.term_code=smg$k_trm_pf2 THEN key.term_code:=smg$k_trm_help ELSE IF key.term_code=smg$k_trm_pf3 THEN key.term_code:=smg$k_trm_find ELSE IF upper_casing THEN BEGIN IF key.ch IN lower_case_chars THEN key.term_code:=key.term_code-32; END; getkey:=key; END; PROCEDURE myreadln(VAR txt : VARYING[upper]OF CHAR; numbers : BOOLEAN:=false); VAR locstr:linefix; str:line; len:unsigned_word; i:INTEGER; BEGIN smg$read_string(keyboard,locstr,resultant_length:=len, display_id:=menu_display); str:=substr(locstr,1,len); IF numbers THEN readv(str,i,error:=continue); IF (NOT numbers) OR (statusv=0) THEN txt:=str ELSE txt:='0'; END; { ================================================================================ } [asynchronous,unbound] PROCEDURE write_menu(title,options:line;vers:BOOLEAN:=true); BEGIN smg$erase_display(menu_display); IF length(title)>0 THEN smg$put_chars(menu_display,title+chr(0),1,1,1,smg$m_reverse); smg$put_chars(menu_display,options+chr(0)); IF vers THEN smg$put_chars(menu_display,'(v'+version+') ',1,screen_cols-7) END; [asynchronous,unbound] PROCEDURE write_top(options:line); BEGIN smg$erase_display(top_display); smg$paste_virtual_display(top_display,pasteboard,screen_rows-1,1); smg$erase_display(top_display); smg$put_chars(top_display,options+chr(0)); END; { ================================================================================ } FUNCTION yesanswer ( prompt : line ) : BOOLEAN; {get a Y or N answer} VAR key:keystroke; BEGIN write_menu('',prompt+'? (Y or N): ',false); REPEAT key:=getkey; yesanswer:= (key.ch = 'Y'); IF NOT (key.ch IN ['Y','N']) THEN smg$ring_bell(menu_display); UNTIL key.ch IN ['Y','N']; IF key.ch='Y' THEN smg$put_chars(menu_display,'Yes',1,length(prompt)+13) ELSE smg$put_chars(menu_display,'No',1,length(prompt)+13) END; { ================================================================================ } PROCEDURE banner; BEGIN smg$erase_display(header_display); IF gigi THEN smg$put_chars_wide(header_display, 'Spell',1,(screen_cols DIV 2)-2, smg$m_bold) ELSE smg$put_chars_highwide(header_display, 'Spell', 1, (screen_cols DIV 2)-4, smg$m_bold); END; { ================================================================================ } PROCEDURE put_help(filename:line); VAR str:line; display:unsigned; BEGIN display:=help_display; open(bannerfile,help_logical+filename,history:=readonly,error:=continue); IF status(bannerfile)>0 THEN BEGIN write_menu('','Unable to open help file! Press any key to continue...'); getkey; GOTO 99; END; reset(bannerfile); smg$erase_display(display); smg$paste_virtual_display(display,pasteboard,3,1); smg$put_line(display,' ',2); WHILE NOT eof(bannerfile) DO BEGIN readln(bannerfile,str); smg$put_line(display,str+chr(0)); END; close(bannerfile,error:=continue); write_menu('','Press any key to continue...'); getkey; smg$unpaste_virtual_display(display,pasteboard); END; [asynchronous,unbound]PROCEDURE out_of_band_handler(param:param_type); VAR key : keystroke; BEGIN CASE param[9] OF ctrl_y, ctrl_c: BEGIN smg$cancel_input(keyboard); write_top('Do you really want to quit? (Y or N):'); key:=getkey; IF key.ch = 'Y' THEN BEGIN {note that listing may not be open here (if NOT using_listing) - however, Pascal requires using_listing to be volatile if we were to use it in this procedure. I chose simply to leave the `error:=continue' there...} close (listing,disposition:=delete,error:=continue); GOTO 99; END; smg$unpaste_virtual_display(top_display,pasteboard); END; ctrl_w: smg$repaint_screen(pasteboard); {refresh the screen} END END; [asynchronous,unbound]PROCEDURE broadcast_handler; VAR MessageStr : PACKED ARRAY [1..256] OF CHAR; {not always just one line} str:line; len:unsigned_word; key:keystroke; temp_display:unsigned; BEGIN smg$get_broadcast_message(pasteboard,MessageStr,len); str:=substr(MessageStr,1,len); smg$create_virtual_display(5,screen_cols-2,temp_display,smg$m_border); smg$put_chars(temp_display,str+chr(0),3,2); smg$put_chars(temp_display,'Incoming message received', 1,(screen_cols DIV 2)-14); smg$put_chars(temp_display, 'Press Q to quit, or any other key to continue...',5,15); smg$paste_virtual_display(temp_display,pasteboard,screen_rows-8,2); smg$ring_bell(temp_display); smg$cancel_input(keyboard); key:=getkey; IF key.ch = 'Q' THEN GOTO 99; smg$delete_virtual_display(temp_display); END; PROCEDURE outerror; {overlong line or over quota} BEGIN smg$erase_display(message_display); smg$paste_virtual_display(message_display,pasteboard,18,2); smg$ring_bell(message_display); smg$put_line(message_display, 'I seem to be having problems writing my output file. Perhaps you have a very'); smg$put_line(message_display, 'long line in your input file, or you have run out of disk space. I am afraid'); smg$put_line(message_display, 'that you will have to start checking your spelling all over again...'); write_menu('','Press any key to return to VMS...'); getkey; IF using_listing THEN close(listing,disposition:=delete,error:=continue); {clear up your mess} IF logging THEN close(logfile,disposition:=delete,error:=continue); GOTO 99; {and get out} END; PROCEDURE quoterror; {insufficient space for output file} BEGIN smg$erase_display(message_display); smg$paste_virtual_display(message_display,pasteboard,18,2); smg$ring_bell(message_display); smg$put_line(message_display, 'I seem to have run out of disk space for my output file. Please check your'); smg$put_line(message_display, 'quota and delete some files if necessary. I''m afraid that you will then have'); smg$put_line(message_display, 'to start checking your spelling all over again...'); write_menu('','Press any key to return to VMS...'); getkey; IF using_listing THEN close(listing,disposition:=delete,error:=continue); {clear up your mess} IF logging THEN close(logfile,disposition:=delete,error:=continue); GOTO 99; {and get out} END; PROCEDURE ofile_error; {illegal output file type} BEGIN smg$erase_display(message_display); smg$paste_virtual_display(message_display,pasteboard,18,2); smg$ring_bell(message_display); smg$put_line(message_display, 'It seems you are trying to check the output from a word-processor (or the like).'); smg$put_line(message_display, 'This is not good sense, as you could probably damage the file''s layout.'); IF NOT yesanswer('Do you really want to carry on') THEN BEGIN {clear up your mess} IF using_listing THEN close(listing,disposition:=delete,error:=continue); IF logging THEN close(logfile,disposition:=delete,error:=continue); IF guidanceOpen THEN close(guidanceFile,error:=continue); GOTO 99; {and get out} END; {endif} END; PROCEDURE persdicterror; {old personal dictionaries (from the Temple} BEGIN {program) don't work any more} smg$erase_display(message_display); smg$paste_virtual_display(message_display,pasteboard,18,2); smg$ring_bell(message_display); smg$put_line(message_display, 'I don''t seem to be able to open your personal dictionary (PERSDICT.DAT).'); smg$put_line(message_display, 'Perhaps you have done the unmentionable, and tried editing it, or you still'); smg$put_line(message_display, 'have one left from the old version of SPELL. Please delete it, then try again.'); write_menu('','Press any key to return to VMS...'); getkey; GOTO 99; END; PROCEDURE openerror(tex:line); {general routine for missing system files} BEGIN smg$erase_display(message_display); smg$paste_virtual_display(message_display,pasteboard,18,2); smg$ring_bell(message_display); smg$put_line(message_display, 'I don''t seem to be able to open the '+tex+'.'); smg$put_line(message_display, 'Please find a friendly system manager, and tell them about this...'); write_menu('','Press any key to return to VMS...'); getkey; GOTO 99; END; { ================================================================================ } PROCEDURE set_gigi; VAR gigi_string:PACKED ARRAY[1..1]OF CHAR; BEGIN lib$get_symbol('GIGI$',gigi_string); gigi:=(gigi_string[1] IN ['T','Y']); END; { =============================================================================== } PROCEDURE analyse_leaf ( VAR leaf : tree; VAR max_depth : INTEGER; depth : INTEGER; VAR chars : INTEGER; VAR words : INTEGER; VAR rounded_bytes : UNSIGNED); { process one leaf of the tree for summary } VAR word_length : INTEGER; { the length of the word in question } BEGIN IF depth>max_depth THEN max_depth := depth; {evaluate depth} words := words+1; IF index(leaf^.name,' ')=0 THEN word_length := 32 ELSE word_length := index(leaf^.name,' ')-1; chars := chars+word_length; rounded_bytes := rounded_bytes+uand(word_length+6, %xfffffffc); IF leaf^.left<>NIL THEN analyse_leaf(leaf^.left, max_depth, depth+1, chars, words, rounded_bytes); IF leaf^.right<>NIL THEN analyse_leaf(leaf^.right, max_depth, depth+1, chars, words, rounded_bytes); END; PROCEDURE summarise_tree (VAR print_to : TEXT; VAR goodtree : tree); { summarise the state of tree } VAR max_depth : INTEGER; { the maximum depth we get to } total_chars : INTEGER; { count of characters in tree } total_words : INTEGER; { count of words in tree } rounded_bytes : UNSIGNED; { count of bytes needed to allocate to characters in the tree } BEGIN max_depth := 0; total_chars := 0; total_words := 0; rounded_bytes := 0; analyse_leaf(goodtree, max_depth, 1, total_chars, total_words, rounded_bytes); writeln(print_to, total_chars:1, ' characters (requiring ', rounded_bytes:1, ' bytes to store them) in ', total_words:1, ' words'); writeln(print_to, 'Tree depth is ', max_depth:1); END; PROCEDURE print_tree (VAR print_to: TEXT; VAR goodtree : tree; depth : INTEGER); (* print a tree, indented appropriately *) VAR i : INTEGER; (* for use in printing the tree branches *) BEGIN IF goodtree^.left<>NIL THEN BEGIN print_tree_flags[depth+1] := -1; print_tree(print_to, goodtree^.left, depth+1); END; IF depth>0 THEN BEGIN IF depth>1 THEN BEGIN FOR i:=1 TO depth-1 DO BEGIN IF print_tree_flags[i]=print_tree_flags[i+1] THEN write(print_to, ' ') ELSE write(print_to, '| '); END; END; write(print_to, '|>'); END; IF index(goodtree^.name,' ')=0 THEN write(print_to, goodtree^.name) ELSE write(print_to, substr(goodtree^.name,1,index(goodtree^.name,' ')-1)); writeln(print_to, ' ',goodtree^.balance:0,' ',goodtree^.SerialNo:0); IF goodtree^.right<>NIL THEN BEGIN print_tree_flags[depth+1] := +1; print_tree(print_to, goodtree^.right, depth+1); END; END; { ================================================================================ } PROCEDURE Insert (ThisWord : WordType; VAR GoodTree : Tree); {put word into tree} VAR father : tree; {the father of pivot (Knuth's T)} pivot : tree; {the point at which balancing may be needed (Knuth's S)} chaser : tree; {for chasing down the tree (Knuth's P)} qTree : tree; {spare tree variable (Knuth's Q)} rTree : tree; {ditto (Knuth's R)} aBalance : BalanceFactor; {a balance factor (Knuth's a)} LABEL 43; BEGIN IF (GoodTree = NIL) THEN BEGIN NEW(GoodTree); GoodTree^.Name := ThisWord; GoodTree^.Left := NIL; GoodTree^.Right := NIL; GoodTree^.Balance := 0; END ELSE BEGIN father := NIL; {signals that father is, in fact, root} pivot := GoodTree; chaser := GoodTree; WHILE chaser<>NIL DO BEGIN IF ThisWord0 THEN BEGIN Father:=chaser; Pivot:=qTree; END; chaser:=qTree; END; END ELSE IF ThisWord>chaser^.Name THEN BEGIN qTree:=chaser^.Right; IF qTree=NIL THEN BEGIN NEW(qTree); chaser^.Right:=qTree; chaser:=NIL; END ELSE BEGIN IF qTree^.Balance<>0 THEN BEGIN Father:=chaser; Pivot:=qTree; END; chaser:=qTree; END; END ELSE BEGIN IF logging AND test_run THEN BEGIN writeln(LogFile); writeln(LogFile, '--- Duplicate name for tree: ', ThisWord); logged_something := true; END; GOTO 43; {oops! already in tree} END; {extended IF} END; {WHILE chaser} {found the right place to insert} qTree^.Name := ThisWord; qTree^.Left := NIL; qTree^.Right := NIL; qTree^.Balance := 0; tree_serial_no := tree_serial_no+1; qTree^.SerialNo := tree_serial_no; IF ThisWordqTree DO BEGIN IF ThisWord0 THEN BEGIN Pivot^.Right:=rTree^.Left; rTree^.Left:=Pivot; END ELSE BEGIN Pivot^.Left:=rTree^.Right; rTree^.Right:=Pivot; END; Pivot^.Balance:=0; rTree^.Balance:=0; END ELSE BEGIN {double rotation} IF logging AND test_run THEN BEGIN writeln(logfile); writeln(logfile, 'Double rotation at pivot ', Pivot^.SerialNo:0); logged_something:=true; END; IF aBalance>0 THEN BEGIN chaser:=rTree^.Left; rTree^.Left:=chaser^.Right; chaser^.Right:=rTree; Pivot^.Right:=chaser^.Left; chaser^.Left:=Pivot; END ELSE BEGIN chaser:=rTree^.Right; rTree^.Right:=chaser^.Left; chaser^.Left:=rTree; Pivot^.Left:=chaser^.Right; chaser^.Right:=Pivot; END; IF chaser^.Balance=aBalance THEN BEGIN Pivot^.Balance:=-aBalance; rTree^.Balance:=0; END ELSE BEGIN Pivot^.Balance:=0; IF chaser^.Balance=0 THEN rTree^.Balance:=0 ELSE rTree^.Balance:=aBalance; END; chaser^.Balance:=0; END; IF father<>NIL {Finishing touch} THEN BEGIN IF Pivot=Father^.Right THEN Father^.Right:=chaser ELSE Father^.Left:=chaser; END ELSE GoodTree:=chaser; END; END; END; {done} IF logging AND test_run THEN BEGIN writeln(logfile); writeln(logfile, '--- inserted name: ', ThisWord); print_tree(logfile, goodtree, 0); logged_something:=true; END; 43: {duplicate name joins here - to exit!} END; PROCEDURE InsertDouble (WrongWord, CorrectWord : WordType; {insert wrong/right} VAR BadTree : DoubleTree); {pair in a tree} BEGIN IF (BadTree = NIL) THEN BEGIN NEW(BadTree); BadTree^.FirstWord := WrongWord; BadTree^.SecondWord := CorrectWord; BadTree^.Left := NIL; BadTree^.Right := NIL END ELSE IF (WrongWord < BadTree^.FirstWord) THEN InsertDouble(WrongWord, CorrectWord, BadTree^.Left) ELSE IF (WrongWord > BadTree^.FirstWord) THEN InsertDouble(WrongWord, CorrectWord, BadTree^.Right) END; PROCEDURE AddWord (NewWord : WordType; position : INTEGER; VAR thisword : listptr); BEGIN {add a word to the list} IF (thisword = NIL) THEN BEGIN new(thisword); thisword^.Name := pad(NewWord,' ',32); thisword^.length := length(NewWord); thisword^.startpos := position; thisword^.next := NIL; wordcount:=wordcount+1; END ELSE { Call Recursively } AddWord(NewWord, position, thisword^.next) END; { ================================================================================ } PROCEDURE openfiles; {open all files} CONST maxexts=7; {number of meaningful extensions} VAR logfilnam,tmpfil:line; colonpos,scolonpos,dotpos,bracpos,i,tmpstat,ext:INTEGER; extensions:PACKED ARRAY [1..maxexts] OF line; BEGIN open(CommonFile,filedir+'Commonwrd.dat',readonly,error:=continue); IF status(commonfile)>0 THEN openerror('common word dictionary'); reset(CommonFile); open (dict1,filedir+'LEXIC08.DAT',history:=readonly,sharing:=readwrite, access_method:=KEYED,organization:=INDEXED,error:=continue); IF status(dict1)>0 THEN openerror('short word dictionary'); dict1_rab:=pas$rab(dict1); dict1_rab^.rab$l_rop := uor(dict1_rab^.rab$l_rop,uor(rab$m_nlk,rab$m_rrl)); open (dict2,filedir+'LEXIC16.DAT',history:=readonly,sharing:=readwrite, access_method:=KEYED,organization:=INDEXED,error:=continue); IF status(dict2)>0 THEN openerror('medium word dictionary'); dict2_rab:=pas$rab(dict2); dict2_rab^.rab$l_rop := uor(dict2_rab^.rab$l_rop,uor(rab$m_nlk,rab$m_rrl)); open (dict3,filedir+'LEXIC32.DAT',history:=readonly,sharing:=readwrite, access_method:=KEYED,organization:=INDEXED,error:=continue); IF status(dict3)>0 THEN openerror('long word dictionary'); dict3_rab:=pas$rab(dict3); dict3_rab^.rab$l_rop := uor(dict3_rab^.rab$l_rop,uor(rab$m_nlk,rab$m_rrl)); open (goodfile,filedir+gdfile, access_method:=KEYED,organization:=INDEXED,history:=UNKNOWN, sharing:=readwrite,error:=continue); IF status(goodfile)>0 THEN openerror('new word file'); goodfile_rab:=pas$rab(goodfile); goodfile_rab^.rab$l_rop := uor(goodfile_rab^.rab$l_rop, uor(rab$m_nlk,rab$m_rrl)); IF using_persdict THEN BEGIN open (persdict,'sys$login:'+pdfile,history:=unknown,sharing:=readwrite, access_method:=KEYED,organization:=INDEXED,error:=continue); IF status(persdict)>0 THEN persdicterror; persdict_rab:=pas$rab(goodfile); persdict_rab^.rab$l_rop := uor(persdict_rab^.rab$l_rop, uor(rab$m_nlk,rab$m_rrl)); END; extensions[1]:='RNO'; {runoff files} extensions[2]:='TEX'; {TeX files} extensions[3]:='MSS'; {Scribe files} extensions[4]:='TXT'; {plain vanilla text} extensions[5]:='ISSUE'; {CGI issue file} extensions[6]:='LATEX'; {LaTeX files} extensions[7]:='SDML'; {VAX Document files} filnam:=param; {wasn't one on the command line} {now we parse the filename - tried to use} {system services for this - found some odd} {VMS bugs - decided to do it myself - sigh..} IF length(filnam)>0 {get first word on command line if anything} THEN {was there} BEGIN WHILE (index(filnam,' ')=1) AND (length(filnam)>0) DO filnam:=substr(filnam,2,length(filnam)-1); {strip leading " "} IF length(filnam)>0 {anything left?} THEN filnam:=substr(filnam,1,index(filnam,' ')-1) {strip trailing " "} END; IF length(filnam)=0 {this is NOT an ELSE! - I fell into this trap} THEN {while trying to clean up the program!} BEGIN write_menu('','File to check: ',vers:=false); myReadln(Filnam); {get a filespec from user} END; IF Length(Filnam)=0 THEN GOTO 99; {user pressed return - exit} dotpos:=0; {position of file.ext type dot} bracpos:=0; {position of ] in filespec} colonpos:=0; {position of : in filespec} ext:=1; {extension index} FOR i := 1 TO length(Filnam) DO {scan filename} BEGIN IF filnam[i]='.' THEN dotpos:=i; IF filnam[i]=']' THEN bracpos:=i; IF filnam[i]=':' THEN colonpos:=i; IF (filnam[i] IN ['a'..'z']) {we really do mean letters w/o diacritics only here} THEN filnam[i] := chr(ord(filnam[i]) - 32); END; IF ((dotpos=0) OR (dotpos0 THEN BEGIN {there's a semicolon - end on it} file_name_len := scolonpos-1-i; {externally usable part} END ELSE BEGIN {no semicolon} file_name_len := length(filnam)-i; {externally usable part} IF ((dotpos=0) OR (dotpos32 THEN BEGIN file_name_len := 32; usable_file_name := substr(filnam,i+1,file_name_len); END ELSE usable_file_name := pad(substr(filnam,i+1,file_name_len), ' ', 32); Open(Document,Filnam,ReadOnly,Error:=Continue, user_action:=open_document); {try opening with given name} Reset(Document,Error:=Continue); tmpstat:=status(Document); {see if we succeeded} IF tmpstat=0 THEN {we did!} BEGIN IF escapemode=unknown THEN BEGIN {we don't know the file type, but...} IF (dotpos=length(filnam)-3) OR {we have a legal extension} (dotpos=index(filnam,';')-4) THEN {check if we know it} BEGIN IF (substr(filnam,dotpos,4)='.MEM') OR (substr(filnam,dotpos,4)='.DVI') OR (substr(filnam,dotpos,4)='.POD') OR (substr(filnam,dotpos,4)='.EXE') OR (substr(filnam,dotpos,4)='.IMP') OR (substr(filnam,dotpos,4)='.DOC') THEN ofile_error; IF substr(filnam,dotpos,4)='.RNO' THEN escapemode:=runoff ELSE IF substr(filnam,dotpos,4)='.TEX' THEN escapemode:=tex ELSE IF substr(filnam,dotpos,4)='.MSS' THEN escapemode:=scribe ELSE escapemode:=unknown {we don't} END ELSE IF (dotpos=length(filnam)-4) OR (dotpos=index(filnam,';')-5) THEN BEGIN IF (substr(filnam,dotpos,5)='.SDML') THEN escapemode := vaxdoc; END ELSE IF (dotpos=length(filnam)-5) OR (dotpos=index(filnam,';')-6) THEN BEGIN IF (substr(filnam,dotpos,6)='.ISSUE') THEN escapemode := issue ELSE IF (substr(filnam,dotpos,6)='.LATEX') THEN escapemode := tex; END; END END ELSE BEGIN IF dotpos=length(filnam) {a filename without an ext} THEN BEGIN REPEAT {try known exts} tmpfil:=filnam+extensions[ext]; Open(Document,tmpfil,ReadOnly,Error:=Continue, user_action:=open_document); Reset(Document,Error:=Continue); tmpstat:=status(Document); ext:=ext+1; UNTIL (ext>maxexts) OR (tmpstat=0); IF tmpstat=0 {found extension} THEN BEGIN filnam:=tmpfil; {set filename and mode} CASE ext OF 2: escapemode:=runoff; 3: escapemode:=tex; 4: escapemode:=scribe; 6: escapemode:=issue; 7: escapemode:=tex; 8: escapemode:=vaxdoc; OTHERWISE escapemode:=unknown; END; END ELSE BEGIN smg$ring_bell(menu_display); write_menu('','Sorry, I can''t find file "' +filnam+'". Press any key to quit...'); getkey; GOTO 99 END END ELSE BEGIN smg$ring_bell(menu_display); write_menu('','Sorry, I can''t find file "' +filnam+'". Press any key to quit...'); getkey; GOTO 99 END END; IF (colonpos>0) OR (bracpos>0) {device or dir specified} THEN BEGIN IF colonpos>bracpos {device only} THEN dev:=substr(filnam,1,colonpos) ELSE {device and/or dir} dev:=substr(filnam,1,bracpos) END ELSE dev:=''; {filename only} IF using_listing THEN BEGIN IF NOT named_listing THEN work_file := substr(filnam,1,dotpos-1)+'.SPELL_WORK_FILE'; Open(listing,work_file,New,error:=continue); {open workfile} Rewrite(listing,error:=continue); IF status(listing)>0 THEN BEGIN smg$erase_display(message_display); smg$paste_virtual_display(message_display,pasteboard,18,2); smg$ring_bell(message_display); smg$put_line(message_display, 'I don''t seem to be able to open my output file "' +filnam+'"'); smg$put_line(message_display, 'Perhaps you are running out of disk space - please check your quota...'); write_menu('','Press any key to return to VMS...'); getkey; GOTO 99 END; END; IF logging THEN BEGIN logfilnam:=substr(filnam,1,dotpos-1)+'.ERR'; {create filename} Open(logfile,logfilnam,New,error:=continue); {open log file} rewrite(logfile,error:=continue); END; IF guidanceNeeded THEN BEGIN {to use/make records of words ignored on previous scans of this file} IF NOT namedGuidanceFile THEN guidanceFileName:='.GUIDANCE_FILE'; open(guidanceFile,guidanceFileName,Readonly, default:=filnam,error:=continue); reset(guidanceFile,error:=continue); IF NOT namedGuidanceFile THEN BEGIN IF status(guidanceFile)>0 {.guidance_file doesn't exist:} THEN {try the generic spell.guidance_file} BEGIN open(guidanceFile,'SPELL.GUIDANCE_FILE',Readonly, default:=filnam,error:=continue); reset(guidanceFile,error:=continue); IF status(guidanceFile)<=0 THEN guidanceFileName:='SPELL.GUIDANCE_FILE'; END; END; IF status(guidanceFile)<=0 THEN {one already exists - we must read it} BEGIN WHILE NOT(eof(guidanceFile)) DO BEGIN readln(guidanceFile,ThisWord,error:=continue); IF ThisWord<>'' THEN Insert ( ThisWord, IgnoreList ); END; close(guidanceFile, error:=continue); open(guidanceFile, guidanceFileName, default:=filnam, history:=old); extend(guidanceFile); guidanceOpen := true; END ELSE guidanceOpen := false; END; lib$trim_filespec((filnam),trim_file,30); smg$paste_virtual_display(status_display,pasteboard,4,2); smg$put_chars(status_display,substr('Processing file : '+trim_file,1,50), 1,2,1); CASE escapemode OF runoff :smg$put_chars(status_display,'Embedded commands: Runoff',2,2,1); tex :smg$put_chars(status_display,'Embedded commands: TeX',2,2,1); scribe :smg$put_chars(status_display,'Embedded commands: Scribe',2,2,1); unknown:smg$put_chars(status_display,'Embedded commands: None',2,2,1); nroff :smg$put_chars(status_display,'Embedded commands: n/troff',2,2,1); issue :smg$put_chars(status_display,'Embedded commands: Issue',2,2,1); vaxdoc :smg$put_chars(status_display,'Embedded commands: VAX Doc',2,2,1); END; END; PROCEDURE closefiles; {close without any errors} BEGIN close (dict1,error:=continue); close (dict2,error:=continue); close (dict3,error:=continue); close (commonfile,error:=continue); close (goodfile,error:=continue); IF using_persdict THEN close (persdict,error:=continue); close (document,error:=continue); document_is_open:=false; IF using_listing AND (maintmode=normal) THEN BEGIN IF errorcount=0 THEN close (listing,disposition:=delete,error:=continue) ELSE BEGIN close (listing,error:=continue); IF status(listing)>0 THEN quoterror; IF NOT named_listing THEN rename_file(work_file, (filnam)); END; {endif errorcount} END; {endif using_listing} IF logging THEN BEGIN IF logged_something THEN close (logfile,error:=continue) ELSE close (logfile,disposition:=delete,error:=continue) END; END; PROCEDURE ReadInCommonWrds; {fill the common word array} VAR I : INTEGER; BEGIN FOR I := 1 TO NumberOfWords DO Readln(CommonFile,CommonWordList[I],error:=continue) END; PROCEDURE PersAdd (WordToAdd : wordtype); {put a word in the personal dict} VAR tmp:word3; BEGIN tmp.item:=WordToAdd; write(persdict,tmp,error:=continue) END; FUNCTION Occurs (WordToFind : wordtype) : BOOLEAN; {checks main dictionaries} VAR wordlen : INTEGER; tmp1 : word1; tmp2 : word2; tmp3 : word3; found:BOOLEAN; BEGIN IF every_word_ok THEN occurs:=true ELSE BEGIN found:=false; wordlen := index(WordToFind,' ')-1; IF wordlen <= 8 {check appropriate dictionary} THEN BEGIN tmp1.item:=substr(WordToFind,1,8); findk(dict1,0,tmp1); found:=NOT ufb(dict1); unlock(dict1, error:=continue); occurs:=found END ELSE IF wordlen <=16 THEN BEGIN tmp2.item:=substr(WordToFind,1,16); findk(dict2,0,tmp2); found:=NOT ufb(dict2); unlock(dict2, error:=continue); occurs:=found END ELSE BEGIN tmp3.item:=WordToFind; findk(dict3,0,tmp3); found:=NOT ufb(dict3); unlock(dict3, error:=continue); occurs:=found END; IF using_persdict THEN BEGIN IF NOT found {check personal dictionary last} THEN BEGIN tmp3.item:=WordToFind; findk(persdict,0,tmp3); occurs := NOT ufb(persdict); unlock(persdict, error:=continue); END; END; END; END; FUNCTION find_in_goodfile ( ThisWord : WordType ) : BOOLEAN; VAR tmp : word3s; BEGIN tmp.item := ThisWord; findk (goodfile, 0, tmp.item, error:=continue); IF ufb(goodfile) THEN find_in_goodfile := false ELSE BEGIN find_in_goodfile := true; END; unlock(goodfile, error:=continue); END; PROCEDURE Check(VAR WordToCheck : wordtype ); {checks spellings in dict} VAR oldword:wordtype;found:BOOLEAN; BEGIN WordToCheck:=''; found:=false; REPEAT write_menu('','Spelling to check (press to quit): ',vers:=false); oldword:=WordToCheck; {keep previous word} myreadln(WordToCheck); IF length(WordToCheck)>0 THEN IF occurs(pad(WordToCheck,' ',32)) THEN BEGIN write_menu('','"'+WordToCheck+ '" is in the dictionary - press any key to continue...'); getkey; found:=true; END ELSE BEGIN write_menu('', '"'+WordToCheck+'" was not found - press any key to continue...'); getkey END; UNTIL (length(WordToCheck)=0) OR found; IF NOT found THEN WordToCheck:=oldword; {only change word if it's there} END; FUNCTION iscommonword (key : wordtype) : BOOLEAN; {check for common words} VAR found : BOOLEAN; low, high, mid : INTEGER; BEGIN found := false; low := 1; high := NumberOfWords; WHILE (low <= high) AND (NOT found) DO BEGIN mid := (low + high) DIV 2; IF key = CommonWordList[mid] THEN found := true ELSE IF key < CommonWordList[mid] THEN high := mid - 1 ELSE low := mid + 1 END; IF found THEN IsCommonWord := true ELSE IsCommonWord := false; END; PROCEDURE status_line(number:INTEGER); {tell user what's going on} VAR temp_string1,temp_string2,temp_string3:line; average:REAL; temp_position : INTEGER; BEGIN IF NOT every_word_ok THEN BEGIN IF wordcount>0 THEN average:=lettertotal / wordcount ELSE average:=0.0; writev(temp_string1,average:3:1); smg$put_chars(status_display,substr('Processing file : '+trim_file,1,50)+ 'Word length: '+temp_string1,1,2,1); CASE escapemode OF runoff:temp_string1:=pad('Embedded commands: Runoff',' ',50); tex :temp_string1:=pad('Embedded commands: TeX',' ',50); scribe:temp_string1:=pad('Embedded commands: Scribe',' ',50); unknown:temp_string1:=pad('Embedded commands: None',' ',50); nroff :temp_string1:=pad('Embedded commands: n/troff',' ',50); issue :temp_string1:=pad('Embedded commands: Issue',' ',50); vaxdoc :temp_string1:=pad('Embedded commands: VAX Doc',' ',50); END; {CASE} writev(temp_string2,errorcount:1); smg$put_chars(status_display,temp_string1+'Error count: '+temp_string2, 2,2,1); writev(temp_string1,number:1); writev(temp_string3,wordcount:1); temp_position:=current_document_position; IF temp_position>=0 THEN BEGIN writev(temp_string2,current_document_position:1); smg$put_chars(status_display,pad('Processing line : '+temp_string1+ ' ('+temp_string2+'%)',' ',50)+ 'Word count : '+temp_string3,3,2,1); END ELSE smg$put_chars(status_display,pad('Processing line : '+temp_string1,' ',50)+ 'Word count : '+temp_string3,3,2,1); END; END; PROCEDURE RecordGuidance ( ThisWord : WordType ); {put word into guidance file} BEGIN IF NOT guidanceOpen THEN BEGIN open(guidanceFile, guidanceFileName, default:=filnam, history:=new, error:=continue); rewrite(guidanceFile, error:=continue); IF status(guidanceFile)<=0 THEN guidanceOpen:=true; END; IF guidanceOpen THEN writeln(guidanceFile, ThisWord); END; PROCEDURE ReadTextLine; {build a tree of words from a line} VAR InLine : Line; Count, LineLength : INTEGER; ScratchWord : wordtype; TeXkwdstart : INTEGER; {start of TeX keyword} State : (BetweenWords, InWord, escape, TeXescape, VAXDocArg, apostrophe); FUNCTION checkescape(count:INTEGER):BOOLEAN; {check for embedded WP commands} BEGIN checkescape:=false; CASE escapemode OF {select appropriate WP} runoff: BEGIN IF (count=1) AND (inline[count]='.') {does .NF type} THEN checkescape:=true ELSE IF (count>1) AND (count1 THEN {only if there's anything} WHILE (tmpcol>1) AND (NOT (inline[tmpcol] IN ['@','(','<','{','"','''','[','`'])) DO tmpcol:=tmpcol-1; {find the @ or previous delim} diff:=count-tmpcol; {save invariant expression} IF diff >= 4 {could be @end(} THEN {keep trying if so} IF substr(inline,tmpcol,4)<>'@end' THEN state:=betweenwords; IF diff >= 6 {could be @begin(} THEN {ditto} IF substr(inline,tmpcol,6)<>'@begin' THEN state:=betweenwords; IF diff < 4 {something else} THEN state:=betweenwords; {whatever it was, it's over} END; {thank God!} issue: IF inline[count]=' ' THEN state := betweenwords; nroff: IF (inline[count]=' ') OR (count>=3) THEN state := betweenwords; vaxdoc: IF inline[count]='>' THEN BEGIN IF count's"? - MUST be a typo!} ELSE possessive:=true; END ELSE possessive:=false; IF possessive THEN {throw it away} BEGIN AddWord(ScratchWord, count-length(ScratchWord)-1, TextLine); ScratchWord := ''; State := BetweenWords; {end the word here} END ELSE BEGIN {this is a real apostrophe} ScratchWord:=ScratchWord+''''+inline[count]; {keep it} state:=inword {we're still in a word} END; END; BEGIN {ReadTextLine} LineNumber := LineNumber + 1; {update line count} IF linenumber MOD 10 = 0 THEN {update status every 10 lines} status_line(linenumber); TextLine := NIL; {start a new list} readln(document, inline, error:=continue); {get a line of text} LineLength := length(inline); prevline:=currline; {set globals} currline:=inline; { Make sure the whole line is lower case. } FOR Count := 1 TO LineLength DO IF (InLine[Count] IN upper_case_chars) THEN inline[count] := chr(ord(inline[count]) + 32); { ^ ^ See? } ScratchWord := ''; {start up line analysis FSA} IF NextLineTeXescape THEN BEGIN State := TeXescape; NextLineTeXescape := FALSE; END ELSE IF NextLineVAXDocArg THEN BEGIN State := VAXDocArg; NextLineVAXDocArg := FALSE; END ELSE State := BetweenWords; FOR Count := 1 TO LineLength DO CASE State OF BetweenWords: processbetween; InWord: processin; escape: processescape; TeXescape: processTeXescape; VAXDocArg: processVAXDocArg; apostrophe: ProcessApostrophe; END; IF (State = InWord) {process last word on line} THEN AddWord(ScratchWord, linelength-length(ScratchWord)+1, TextLine) ELSE BEGIN IF (State=TeXescape) THEN NextLineTeXescape := TRUE ELSE IF (State=VAXDocArg) THEN NextLineVAXDocArg := TRUE; END; END; FUNCTION OccursInTree ( WordToFind : wordtype; WordList: Tree) : BOOLEAN; BEGIN {find a word in a tree} IF (WordList = NIL) THEN OccursInTree := FALSE ELSE IF (WordList^.Name = ThisWord) THEN OccursInTree := TRUE ELSE IF (WordList^.Name < ThisWord) THEN OccursInTree := OccursInTree(ThisWord, WordList^.Right) ELSE OccursInTree := OccursInTree(ThisWord, WordList^.Left); END; PROCEDURE SearchDouble (WordToFind : wordtype; Misspelled : Doubletree; VAR Found : BOOLEAN; VAR CorrectWord : wordtype); {look for a word in the wrong/right list} BEGIN IF (Misspelled = NIL) THEN Found := FALSE ELSE IF (Misspelled^.FirstWord = WordToFind) THEN BEGIN Found := TRUE; CorrectWord := Misspelled^.SecondWord END ELSE IF Misspelled^.FirstWord < WordToFind THEN SearchDouble(WordToFind, Misspelled^.Right, Found, CorrectWord) ELSE SearchDouble(WordToFind, Misspelled^.Left, Found, CorrectWord) END; PROCEDURE querycase; {makes sure that case of corrected words} VAR ch:CHAR; {is right - asks if necessary} i:INTEGER; allupper,alllower,capital:BOOLEAN; {knows about normal capitalizations} tmpword:wordtype; PROCEDURE getnewcase; {get proper case if necessary - only for} VAR key : keystroke; cursor_col, wd_ptr : INTEGER; BEGIN {weird words like "TeX"} IF NOT yesanswer('Are you happy with the capitalization of "' +correctword+'"') THEN BEGIN {============================================================================== write_menu('','Please type the word the way you want it to appear: ', vers:=false); myreadln(correctword) ==============================================================================} write_menu('Correct case:', ' '+correctword, vers:=false); cursor_col:=15; wd_ptr:=1; smg$set_cursor_abs(menu_display, 1, cursor_col); REPEAT key:=getkey; CASE key.term_code OF smg$k_trm_left: IF wd_ptr=1 THEN smg$ring_bell(menu_display) ELSE BEGIN wd_ptr:=wd_ptr-1; smg$set_cursor_rel(menu_display, delta_column:=-1); END; smg$k_trm_right: IF wd_ptr=length(correctword) THEN smg$ring_bell(menu_display) ELSE BEGIN wd_ptr:=wd_ptr+1; smg$set_cursor_rel(menu_display, delta_column:=1); END; smg$k_trm_bs, smg$k_trm_f12: IF wd_ptr=1 THEN smg$ring_bell(menu_display) ELSE BEGIN wd_ptr:=1; smg$set_cursor_abs(menu_display, 1, cursor_col); END; smg$k_trm_ctrle, smg$k_trm_kp2: IF wd_ptr=length(correctword) THEN smg$ring_bell(menu_display) ELSE BEGIN wd_ptr:=length(correctword); smg$set_cursor_abs(menu_display, 1, cursor_col+ wd_ptr-1); END; smg$k_trm_up: IF correctword.body[wd_ptr] IN upper_case_chars THEN smg$ring_bell(menu_display) ELSE BEGIN correctword.body[wd_ptr]:= chr(ord(correctword.body[wd_ptr])-32); smg$put_chars(menu_display, substr(correctword,wd_ptr,1), 1, cursor_col+wd_ptr-1); IF wd_ptr=length(correctword) THEN smg$set_cursor_abs(menu_display, 1, cursor_col+ wd_ptr-1) ELSE wd_ptr:=wd_ptr+1; END; smg$k_trm_down: IF correctword.body[wd_ptr] IN lower_case_chars THEN smg$ring_bell(menu_display) ELSE BEGIN correctword.body[wd_ptr]:= chr(ord(correctword.body[wd_ptr])+32); smg$put_chars(menu_display, substr(correctword,wd_ptr,1), 1, cursor_col+wd_ptr-1); IF wd_ptr=length(correctword) THEN smg$set_cursor_abs(menu_display, 1, cursor_col+ wd_ptr-1) ELSE wd_ptr:=wd_ptr+1; END; smg$k_trm_help: BEGIN put_help('CHECK_CASE.SPELL_HELP'); write_menu('Correct case:', ' '+correctword, vers:=false); smg$set_cursor_abs(menu_display, 1, cursor_col+ wd_ptr-1); END; smg$k_trm_cr, smg$k_trm_f10, smg$k_trm_enter: {do nothing - these take us out}; OTHERWISE smg$ring_bell(menu_display); END; UNTIL (key.term_code=smg$k_trm_cr) OR (key.term_code=smg$k_trm_f10) OR (key.term_code=smg$k_trm_enter); END; END; BEGIN {querycase} tmpword:=substr(currline,textline^.startpos,textline^.length); allupper:=true; alllower:=true; capital:=false; IF textline^.length=1 {original word was single letter} THEN BEGIN IF length(correctword)=1 {set one-letter replacement to original case} THEN BEGIN IF (tmpword[1] IN lower_case_chars) AND (correctword[1] IN upper_case_chars) THEN correctword.body[1]:=chr(ord(correctword.body[1])+32); IF (tmpword[1] IN upper_case_chars) AND (correctword[1] IN lower_case_chars) THEN correctword.body[1]:=chr(ord(correctword.body[1])-32); END ELSE {don't know case if original is one letter} getnewcase {and replacement is longer} END ELSE {multi letter original} IF length(correctword)>0 THEN BEGIN IF tmpword.body[1] IN upper_case_chars THEN capital:=true; {initial Cap} FOR i:=1 TO textline^.length DO {get word type} BEGIN IF tmpword.body[i] IN upper_case_chars THEN BEGIN alllower:=false; {not lc} IF i>1 THEN capital:=false; {not Cap} END; IF tmpword.body[i] IN lower_case_chars THEN allupper:=false; {not UC} END; IF capital {this is a "Capitalized" word} THEN BEGIN IF correctword.body[1] IN lower_case_chars THEN correctword.body[1]:=chr(ord(correctword.body[1])-32); FOR i:=2 TO length(correctword) DO IF correctword.body[i] IN upper_case_chars THEN correctword.body[i]:=chr(ord(correctword.body[i])+32); END ELSE IF alllower {this word is all "lower" case} THEN BEGIN FOR i:=1 TO length(correctword) DO IF correctword.body[i] IN upper_case_chars THEN correctword.body[i]:=chr(ord(correctword.body[i])+32) END ELSE IF allupper {this word is all "UPPER" case} THEN BEGIN FOR i:=1 TO length(correctword) DO IF correctword.body[i] IN lower_case_chars THEN correctword.body[i]:=chr(ord(correctword.body[i])-32) END ELSE getnewcase {ask user to specify case} END; END; PROCEDURE updateline; {fix line after a correction} {updates global currline} VAR tmproot:listptr; secpos,diff:INTEGER; part1,part2:line; BEGIN errorcount:=errorcount+1; {fixed an error} IF logging THEN BEGIN writeln(logfile,'line ',linenumber:4,': "',ThisWord:index(ThisWord,' ')-1, '" --> "',correctword:length(correctword),'"',error:=continue); logged_something :=true; END; tmproot:=textline; {remember root of word list} diff:=index(ThisWord,' ')-length(correctword)-1;{get difference in lengths} IF textline^.startpos>1 {split currline in two} THEN part1:=substr(currline,1,textline^.startpos-1){part1 up to error} ELSE part1:=''; secpos:=textline^.startpos+textline^.length; {part2 after error} IF secpos<=length(currline) THEN part2:=substr(currline,secpos,length(currline)-secpos+1) ELSE part2:=''; currline:=''; {clear current line} IF length(part1)>0 THEN currline:=part1+correctword {assemble new line} ELSE currline:=correctword; IF length(part2)>0 THEN currline:=currline+part2; textline^.length:=textline^.length-diff; WHILE textline<>NIL {patch word-list start} DO BEGIN {positions for subsequent} textline^.startpos:=textline^.startpos-diff; {fixes on same line} textline:=textline^.next END; textline:=tmproot; {restore word-list pointer} END; PROCEDURE update_disposition(str:line); VAR temp_string:line; BEGIN writev(temp_string,linenumber:5); smg$put_chars(error_display, temp_string+' '+pad(ThisWord,' ',32)+'>>> '+str,3,1); END; {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Expand_line expands all tabs in the input line to spaces, then extracts the relevant bit of the line into the output line, setting clipleft and clipright to indicate where the line had to be truncated for contextscreen's use (the position and size of the word (if any) that needs to be highlit are given in duffpos and dufflen; expand_line updates duffpos if necessary to show movement arising from tabs. Expand_line may be used for both currline and prevline (for which set duffpos to 1 in call). -----------------------------------------------------------------------------} PROCEDURE expand_line (VAR inputline : line; {in: line to be processed} VAR outputline : line; {out: processed line} VAR duffpos : INTEGER; {in: the position of the problem word in inputline out: ditto in outputline} dufflen : INTEGER; {in: length of same} VAR clipleft : BOOLEAN; {out: clipped at left?} VAR clipright : BOOLEAN); {out: right?} VAR char_cols : ARRAY [1..maxline] OF INTEGER; i : INTEGER; lstr : INTEGER; col : INTEGER; lastnb : INTEGER := 0; {last non-blank position on the line} optr : INTEGER := 1; iptr : INTEGER := 1; newleftmarg : INTEGER; tmplen, tmppos : INTEGER; opos : INTEGER; ch : CHAR; hadtab : BOOLEAN := FALSE; BEGIN lstr := length(inputline); col := 1; FOR i := 1 TO lstr DO BEGIN char_cols[i] := col; IF inputline.body[i] = chr(9) THEN BEGIN {The hacker's instinct here is to mask; however, VAX Pascal makes one jump through so many hoops it's not worth (Wirth?) it!} col := (((col + 7) DIV 8) * 8) + 1; hadtab := TRUE; END ELSE BEGIN {normal character advance} IF inputline.body[i] <> ' ' THEN lastnb := i; col := col+1; END; END; {calculate column positions of each character} IF lastnb = 0 THEN BEGIN {it's a totally empty line (presumably we're looking at prevline ;-)} outputline := ''; clipleft := FALSE; clipright := FALSE; END ELSE IF char_cols[lastnb] <= (screen_cols-2) THEN BEGIN {we can fit the entire line} clipleft := FALSE; clipright := FALSE; newleftmarg := 1; IF NOT hadtab THEN BEGIN {no tabs: dead simple (duffpos unchanged)} outputline := inputline; {let the compiler optimise the common case} END ELSE BEGIN FOR i := 1 TO lastnb DO BEGIN {expand tabs as necessary} IF inputline.body[i] = chr(9) THEN BEGIN {insert spaces to expand a tab} WHILE optr < char_cols[i+1] DO BEGIN outputline.body[optr] := ' '; optr := optr+1; END; END ELSE BEGIN {simply copy character} outputline.body[optr] := inputline.body[i]; optr := optr+1; END; END; duffpos := char_cols[duffpos]; outputline.length := optr-1; END; END ELSE BEGIN {can't fit the entire line} tmplen := (screen_cols-2)-line_break_flag_len; tmppos := char_cols[duffpos]+(dufflen DIV 2); IF tmppos <= (tmplen DIV 2) THEN BEGIN clipleft := FALSE; clipright := TRUE; newleftmarg := 1; duffpos := char_cols[duffpos]; END ELSE IF tmppos >= char_cols[lastnb]-(tmplen DIV 2) THEN BEGIN {duff word is sufficiently near the end of the line that we can display up to the end of the line} clipleft := TRUE; clipright := FALSE; newleftmarg := char_cols[lastnb] - tmplen + 1; duffpos := char_cols[duffpos] - newleftmarg + 2; END ELSE BEGIN {really short of space - neither the left nor the right margin of the line will fit on the context screen} clipleft := TRUE; clipright := TRUE; {there is a break at beginning and end of the line, so it loses yet another character to the dread diamonds} tmplen := tmplen-line_break_flag_len; {fix the middle of the duff word in the middle of the displayed bit of the line} newleftmarg := char_cols[duffpos]+(dufflen DIV 2)-(tmplen DIV 2); duffpos := char_cols[duffpos] - newleftmarg + 2; END; {now copy what's needed to the output} WHILE char_cols[iptr] < newleftmarg DO iptr := iptr+1; opos := newleftmarg; WHILE optr <= tmplen DO BEGIN WHILE opos>> '); END; smg$erase_display(context_display); IF NOT pasted THEN smg$paste_virtual_display(context_display,pasteboard,14,2); pasted:=true; expand_line(prevline, context_line, context_column, 0, cl, cr); smg$put_chars(context_display, context_line, prevline_row, 1); IF cr THEN smg$put_chars(context_display,line_break_flag, prevline_row,79-line_break_flag_len, character_set:=smg$c_spec_graphics); duff_word_len := textline^.length; duff_word_pos := textline^.startpos; {initial conditions...} expand_line(currline, context_line, duff_word_pos, duff_word_len, cl, cr); IF cl THEN BEGIN {clipped at start of line} smg$put_chars(context_display, line_break_flag, currline_row, 1, character_set:=smg$c_spec_graphics); context_column := 1+line_break_flag_len; END ELSE context_column := 1; smg$put_chars(context_display, context_line, currline_row, context_column); IF cr THEN BEGIN {clipped at end of line (possibly both, of course)} smg$put_chars(context_display,line_break_flag,currline_row, 79-line_break_flag_len, character_set:=smg$c_spec_graphics); END; smg$change_rendition(context_display, currline_row, duff_word_pos, 1, duff_word_len, rendition_set := smg$m_reverse); smg$end_pasteboard_update(pasteboard); END; PROCEDURE judge(VAR textline:listptr); {main judgement procedure for errors} VAR Count : INTEGER; Verdict : CHAR; key : keystroke; oldword : listptr; FUNCTION guess:BOOLEAN; {guess a spelling - add any clever} {guessing algorithms in here} LABEL 88,89; {no real excuse here - the logic} {actually seemed clearer with them} VAR i,col:INTEGER; oldword,tmpword:wordtype; {...to the author at least!} ch:CHAR; go_on,guessed:BOOLEAN; guess_key_awaits : BOOLEAN := FALSE; {for asynchronous keyboard} guesses : ARRAY ['a'..'z'] OF wordtype; {accumulated so far} guess_index : CHAR := 'a'; {next one to add} guess_display_row : INTEGER := 1; {where to display } guess_display_col : INTEGER := 1; { the next guess} [asynchronous,unbound] PROCEDURE unsol_input_notification; BEGIN had_unsol_input := TRUE; END; FUNCTION display_guess (next_guess : wordtype) : BOOLEAN; {Display a guess in the asynchronous guess virtual display} VAR guess_length : INTEGER; {for calculating position of next} guess_scan : CHAR; {loop variable} already_guessed : BOOLEAN := FALSE; {is there an existing guess of the same spelling?} BEGIN guess_scan := 'a'; WHILE ((guess_scan<='z') AND (guess_scan screen_cols-2 THEN BEGIN guess_display_row:=guess_display_row+1; guess_display_col:=1; END; smg$put_chars(guess_display, chr(ord(guess_index)-32)+': '+ substr(next_guess,1,guess_length), guess_display_row, guess_display_col); smg$flush_buffer(pasteboard); guess_display_col := guess_display_col+guess_length+5; {the following check won't be necessary when confirmguess responds to our function result being FALSE...} IF guess_index<='z' THEN guesses[guess_index] := next_guess; guess_index := succ(guess_index); END; IF guess_index>'z' THEN display_guess:=FALSE ELSE display_guess:=TRUE; END; PROCEDURE get_guess_disposition (max_guess : CHAR); VAR got_ok_key : BOOLEAN := FALSE; key_return : INTEGER; key : keystroke; BEGIN REPEAT key_return := smg$read_keystroke(keyboard,key.term_code); {ignores return, pro tem} IF ((key.term_code=SMG$K_TRM_CTRLZ) OR (key.term_code=smg$k_trm_pf4) OR (key.term_code=smg$k_trm_next_screen)) THEN GOTO 89 {request to abandon guessing} ELSE IF ((key.term_code=smg$k_trm_pf2) OR (key.term_code=smg$k_trm_help)) THEN put_help('guess.spell_help') ELSE BEGIN IF key.ch IN upper_case_chars THEN key.ch := chr(ord(key.ch)+32); IF ((key.ch<'a') OR (key.ch>max_guess)) THEN BEGIN smg$ring_bell(guess_display); smg$cancel_input(keyboard); END ELSE BEGIN got_ok_key:=true; tmpword := guesses[key.ch]; GOTO 88; END; END; UNTIL got_ok_key; END; FUNCTION confirmguess:BOOLEAN; {see if synthesized spelling exists} VAR We_have_it : BOOLEAN; {look-up success} key : keystroke; {for determining what's what} key_return : INTEGER; {have we read something?} BEGIN We_have_it := OccursInTree( tmpword, IgnoreList ); IF NOT We_have_it THEN We_have_it := IsCommonWord( tmpword ); IF NOT We_have_it THEN We_have_it := occurs( tmpword ); IF We_have_it {same check as for any word in text} THEN BEGIN IF (NOT display_guess(tmpword)) {get the thing into the display} THEN BEGIN write_menu('','Guessing done - please make your selection...'); get_guess_disposition('z'); {guess display is full - do we need to cancel unsolicited input now, or can we just leave it?} END; END; {guess entered in display} IF had_unsol_input THEN BEGIN had_unsol_input := FALSE; {SMG seems to guarantee that this is safe} key_return := smg$read_keystroke(keyboard,key.term_code,timeout:=0); IF key_return=smg$_eof THEN BEGIN key_return := 1; {this is `odd', if not `puckah' ;-} key.term_code := smg$k_trm_ctrlz; END; IF odd(key_return) {read something puckah} THEN BEGIN IF ((key.term_code=smg$k_trm_ctrlz) OR (key.term_code=smg$k_trm_pf4) OR (key.term_code=smg$k_trm_next_screen)) THEN GOTO 89 {request to abandon guessing} ELSE IF ((key.term_code=smg$k_trm_pf2) OR (key.term_code=smg$k_trm_help)) THEN put_help('guess.spell_help') ELSE BEGIN IF key.ch IN upper_case_chars THEN key.ch := chr(ord(key.ch)+32); IF ((key.ch<'a') OR (key.ch>=guess_index)) THEN BEGIN smg$ring_bell(guess_display); smg$cancel_input(keyboard); END ELSE BEGIN guessed:=true; tmpword := guesses[key.ch]; GOTO 88; END; END; END; END; confirmguess := FALSE; {function result is a relic} END; PROCEDURE guess_reversals; {try reversals - e.g. teh for the} BEGIN IF textline^.length>1 THEN FOR col:=1 TO textline^.length-1 DO BEGIN ch:=tmpword[col]; tmpword[col]:=tmpword[col+1]; tmpword[col+1]:=ch; IF confirmguess THEN GOTO 88; ch:=tmpword[col]; tmpword[col]:=tmpword[col+1]; tmpword[col+1]:=ch; END; END; PROCEDURE guess_vowels; {try vowel replacements} BEGIN FOR col:=1 TO textline^.length DO IF tmpword[col] IN ['a','e','i','o','u'] THEN BEGIN ch:=tmpword[col]; IF ch<>'a' THEN BEGIN tmpword[col]:='a'; IF confirmguess THEN GOTO 88; END; IF ch<>'e' THEN BEGIN tmpword[col]:='e'; IF confirmguess THEN GOTO 88; END; IF ch<>'i' THEN BEGIN tmpword[col]:='i'; IF confirmguess THEN GOTO 88; END; IF ch<>'o' THEN BEGIN tmpword[col]:='o'; IF confirmguess THEN GOTO 88; END; IF ch<>'u' THEN BEGIN tmpword[col]:='u'; IF confirmguess THEN GOTO 88; END; tmpword[col]:=ch; END; END; PROCEDURE guess_minus; {try eliding one letter at a time} BEGIN FOR col := 1 TO textline^.length DO BEGIN oldword:=tmpword; FOR i:= col TO textline^.length DO tmpword.body[i]:=tmpword.body[i+1]; IF confirmguess THEN GOTO 88; tmpword:=oldword; END; END; PROCEDURE guess_apostrophe; {try adding apostrophe between trailing "nt", or try stripping a trailing "s" off a word and see if we can make it a posessive} VAR We_have_it : BOOLEAN; {look-up success} BEGIN oldword := tmpword; IF (tmpword[textline^.length-1] = 'n') AND (tmpword[textline^.length] = 't') THEN BEGIN tmpword[textline^.length+1]:='t'; tmpword[textline^.length]:=''''; IF confirmguess THEN GOTO 88; tmpword := oldword; END; (* Now, try to convert "zorros" to "zorro's" *) IF tmpword[textline^.length]='s' THEN BEGIN tmpword[textline^.length]:=' '; We_have_it := OccursInTree( tmpword, IgnoreList ); IF NOT We_have_it THEN We_have_it := IsCommonWord( tmpword ); IF NOT We_have_it THEN We_have_it := occurs( tmpword ); IF We_have_it THEN BEGIN tmpword[textline^.length]:=''''; tmpword[textline^.length+1]:='s'; {code copied from confirmguess (almost)} IF (NOT display_guess(tmpword)) THEN BEGIN write_menu('','Guessing done - please make your selection...'); get_guess_disposition('z'); END; END; tmpword:=oldword; END; END; PROCEDURE guess_plus; {add one letter anywhere in the word} VAR no_u: BOOLEAN; {suppress adding "u" between "o" and "r", as it's been done once already} BEGIN oldword:=tmpword; {make a gap: will propagate up through the word} FOR col := textline^.length DOWNTO 1 DO tmpword.body[col+1] := tmpword.body[col]; {add in each position} FOR col := 1 TO textline^.length+1 DO BEGIN IF col>1 THEN BEGIN tmpword.body[col-1] := tmpword.body[col]; IF col>textline^.length THEN no_u:=false ELSE IF (tmpword.body[col-1]='o') AND (tmpword.body[col+1]='r') THEN no_u:=true ELSE no_u:=false; END ELSE no_u:=false; {can't have happened in column 1} FOR ch := 'a' TO 'z' DO BEGIN IF (NOT no_u) OR (ch<>'u') THEN BEGIN tmpword.body[col] := ch; IF confirmguess THEN GOTO 88; END; END; END; tmpword := oldword; END; PROCEDURE guess_consonants; {replacement for all characters} BEGIN FOR col := 1 TO textline^.length DO BEGIN oldword:=tmpword; FOR ch:='a' TO 'z' DO BEGIN tmpword.body[col]:=ch; IF confirmguess THEN GOTO 88; END; tmpword:=oldword; END; END; PROCEDURE guess_zs; {try swapping zs to ss} VAR i : INTEGER; BEGIN oldword := tmpword; FOR i := 1 TO textline^.length DO BEGIN IF tmpword.body[i] = 'z' THEN BEGIN tmpword.body[i] := 's'; IF confirmguess THEN GOTO 88; tmpword := oldword; END; END; END; PROCEDURE guess_cst; {try swapping cs to ss to ts} {this is for the benefit of Paul Hardy's hangups!} VAR i : INTEGER; BEGIN oldword := tmpword; FOR i := 2 TO textline^.length-1 DO BEGIN IF tmpword.body[i+1] = 'i' THEN BEGIN IF tmpword.body[i] = 'c' THEN BEGIN tmpword.body[i] := 's'; IF confirmguess THEN GOTO 88; tmpword.body[i] := 't'; IF confirmguess THEN GOTO 88; tmpword := oldword; END; IF tmpword.body[i] = 's' THEN BEGIN tmpword.body[i] := 'c'; IF confirmguess THEN GOTO 88; tmpword.body[i] := 't'; IF confirmguess THEN GOTO 88; tmpword := oldword; END; IF tmpword.body[i] = 't' THEN BEGIN tmpword.body[i] := 'c'; IF confirmguess THEN GOTO 88; tmpword.body[i] := 's'; IF confirmguess THEN GOTO 88; tmpword := oldword; END; END; END; END; PROCEDURE guess_qu; {try adding "u" after "q"} VAR i, j : INTEGER; BEGIN oldword := tmpword; FOR i := 2 TO textline^.length DO BEGIN IF (tmpword.body[i-1] = 'q') AND (tmpword.body[i] <> 'u') THEN BEGIN FOR j := textline^.length DOWNTO i DO tmpword.body[j+1] := tmpword.body[j]; tmpword.body[i] := 'u'; IF confirmguess THEN GOTO 88; tmpword := oldword; END; END; END; PROCEDURE guess_or; {try adding "u" to "or"} VAR i, j : INTEGER; BEGIN oldword := tmpword; FOR i := 2 TO textline^.length DO BEGIN IF (tmpword.body[i-1] = 'o') AND (tmpword.body[i] = 'r') THEN BEGIN FOR j := textline^.length DOWNTO i DO tmpword.body[j+1] := tmpword.body[j]; tmpword.body[i] := 'u'; IF confirmguess THEN GOTO 88; tmpword := oldword; END; END; END; BEGIN {guess} had_unsol_input := FALSE; smg$enable_unsolicited_input(pasteboard,unsol_input_notification); smg$cancel_input(keyboard); smg$erase_display(guess_display); smg$paste_virtual_display(guess_display,pasteboard,screen_rows-8,2); write_menu('','Guessing - please make your selection...'); guess:=false; guessed:=false; tmpword:=ThisWord; {don't mess around with real word} guess_zs; {guess 'z's for 's's} guess_cst; {guess 'c's for 's's for 't's - for Paul} guess_or; {guess 'our' for 'or'} guess_qu; {guess 'u' after 'q' - for Paul} { and no, I don't think Paul's a particularly bad typist - he just takes the trouble to ask for improvements to the algorithms } guess_apostrophe; {guess "'" between trailing "nt"} guess_reversals; {guess for reversals} guess_vowels; {guess for incorrect vowels} guess_minus; {guess for extra letters} guess_plus; {add one letter at a time} guess_consonants; {substitute for all consonants} IF guess_index='a' THEN GOTO 89 {no guesses at all} ELSE write_menu('','Guessing done - please make your selection...'); guess_index := pred(guess_index); get_guess_disposition(guess_index); {establish results, if any!} 88: guess:=true; {we managed to guess - even though we} IF index(tmpword,' ')>0 {immediately destroyed our reputation by} THEN {doing a GOTO - but then the users never know!} correctword:=substr(tmpword,1,index(tmpword,' ')-1) ELSE correctword:=tmpword; 89: {real exit} smg$disable_unsolicited_input(pasteboard); smg$unpaste_virtual_display(guess_display,pasteboard); END; PROCEDURE edit_word(ThisWord : wordtype; VAR correctWord : wordtype; cursor_col : INTEGER); VAR ins_repl : BOOLEAN; {True=>insert, false=>replace} wd_ptr : INTEGER; key : keystroke; ch_arr : PACKED ARRAY [1..1] OF CHAR; BEGIN CorrectWord:=substr(ThisWord,1,index(ThisWord,' ')-1); upper_casing:=false; {don't upper-case letters from keyboard} ins_repl:=true; {start by inserting, not replacing} wd_ptr:=1; {start at start of word} REPEAT key:=getkey; IF key.term_code=smg$k_trm_left THEN BEGIN IF wd_ptr=1 THEN smg$ring_bell(menu_display) ELSE BEGIN wd_ptr:=wd_ptr-1; smg$set_cursor_rel(menu_display, delta_column:=-1); END; END ELSE IF key.term_code=smg$k_trm_right THEN BEGIN IF wd_ptr>length(correctword) THEN smg$ring_bell(menu_display) ELSE BEGIN IF (wd_ptr=length(correctword)) AND NOT ins_repl THEN BEGIN ins_repl:=true; smg$change_rendition(menu_display, 1, cursor_col, 1, length(correctword), smg$m_reverse, smg$m_reverse); END; smg$set_cursor_rel(menu_display, delta_column:=1); wd_ptr:=wd_ptr+1; END; END ELSE IF key.term_code=smg$k_trm_delete THEN BEGIN {delete a character} IF wd_ptr=1 THEN smg$ring_bell(menu_display) ELSE BEGIN IF wd_ptr>length(CorrectWord) THEN CorrectWord:=substr(CorrectWord,1,length(CorrectWord)-1) ELSE CorrectWord:=substr(CorrectWord,1,wd_ptr-2) + substr(CorrectWord,wd_ptr, length(CorrectWord)-wd_ptr+1); wd_ptr:=wd_ptr-1; smg$delete_chars(menu_display, 1, 1, cursor_col+wd_ptr-1); END; {endif} END ELSE IF (key.term_code=smg$k_trm_ctrln) THEN BEGIN IF wd_ptr<=2 THEN smg$ring_bell(menu_display) ELSE BEGIN IF wd_ptr>length(CorrectWord) THEN BEGIN IF wd_ptr=3 THEN CorrectWord:=substr(CorrectWord,2,1)+substr(CorrectWord,1,1) ELSE CorrectWord:=substr(CorrectWord,1,wd_ptr-3)+ substr(CorrectWord,wd_ptr-1,1)+ substr(CorrectWord,wd_ptr-2,1); END ELSE IF wd_ptr=3 THEN CorrectWord:=substr(CorrectWord,2,1)+substr(CorrectWord,1,1)+ substr(CorrectWord,3,length(CorrectWord)-2) ELSE CorrectWord:=substr(CorrectWord,1,wd_ptr-3)+ substr(CorrectWord,wd_ptr-1,1)+ substr(CorrectWord,wd_ptr-2,1)+ substr(CorrectWord,wd_ptr,length(CorrectWord)-wd_ptr+1); smg$put_chars(menu_display, substr(CorrectWord,wd_ptr-2,2), 1, cursor_col+wd_ptr-3); END; END ELSE IF (key.term_code=smg$k_trm_ctrla) OR (key.term_code=smg$k_trm_f14) THEN BEGIN IF wd_ptr>length(CorrectWord) THEN smg$ring_bell(menu_display) ELSE BEGIN ins_repl := NOT ins_repl; IF ins_repl THEN smg$change_rendition(menu_display, 1, cursor_col, 1, length(correctword), smg$m_reverse, smg$m_reverse) ELSE smg$change_rendition(menu_display, 1, cursor_col, 1, length(correctword), smg$m_reverse); END; END ELSE IF (key.term_code=smg$k_trm_bs) OR (key.term_code=smg$k_trm_f12) THEN BEGIN IF wd_ptr=1 THEN smg$ring_bell(menu_display) ELSE BEGIN wd_ptr:=1; smg$set_cursor_abs(menu_display, 1, cursor_col); END; END ELSE IF (key.term_code=smg$k_trm_remove) OR (key.term_code=smg$k_trm_comma) THEN BEGIN IF wd_ptr>length(correctword) THEN smg$ring_bell(menu_display) ELSE IF wd_ptr=length(correctword) THEN BEGIN correctword:=substr(CorrectWord,1,length(correctword)-1); IF NOT ins_repl THEN BEGIN ins_repl:=true; smg$change_rendition(menu_display, 1, cursor_col, 1, length(correctword), smg$m_reverse, smg$m_reverse); END; END ELSE IF wd_ptr=1 THEN CorrectWord:=substr(CorrectWord,2,length(CorrectWord)-1) ELSE CorrectWord:=substr(CorrectWord,1,wd_ptr-1) + substr(CorrectWord,wd_ptr+1,length(CorrectWord)-wd_ptr); smg$delete_chars(menu_display, 1, 1, cursor_col+wd_ptr-1); END ELSE IF (key.term_code=smg$k_trm_ctrle) OR (key.term_code=smg$k_trm_kp2) THEN BEGIN IF wd_ptr>length(CorrectWord) THEN smg$ring_bell(menu_display) ELSE BEGIN wd_ptr:=length(CorrectWord)+1; smg$set_cursor_abs(menu_display, 1, cursor_col+wd_ptr-1); IF NOT ins_repl THEN BEGIN ins_repl:=true; smg$change_rendition(menu_display, 1, cursor_col, 1, length(correctword), smg$m_reverse, smg$m_reverse); END; {endif} END; {endif, too} END ELSE IF key.term_code=smg$k_trm_help THEN BEGIN put_help('EDIT.SPELL_HELP'); write_menu('Edit spelling:',' '+substr(ThisWord,1,index(ThisWord,' ')-1), vers:=false); smg$set_cursor_abs(menu_display, 1, cursor_col+wd_ptr-1); END ELSE IF key.ch IN [' '..'~'] {any printable character, or space} THEN BEGIN ch_arr[1]:=key.ch; IF ins_repl THEN BEGIN {add a character} IF length(correctword)=32 THEN smg$ring_bell(menu_display) ELSE BEGIN IF wd_ptr=1 THEN CorrectWord:=key.ch+CorrectWord ELSE IF wd_ptr>length(CorrectWord) THEN CorrectWord:=CorrectWord+key.ch ELSE CorrectWord:=substr(CorrectWord,1,wd_ptr-1) + key.ch + substr(CorrectWord,wd_ptr,length(CorrectWord)-wd_ptr+1); {endif} {and now stuff it into the display of the word} smg$insert_chars(menu_display, ch_arr, 1, cursor_col+wd_ptr-1); END; {endif} END ELSE BEGIN {replace one} CorrectWord.body[wd_ptr]:=key.ch; {this way, too, it needs to be in the display} smg$put_chars(menu_display, ch_arr, 1, cursor_col+wd_ptr-1, 0, smg$m_reverse); IF wd_ptr=length(CorrectWord) THEN BEGIN ins_repl:=true; smg$change_rendition(menu_display, 1, cursor_col, 1, length(correctword), smg$m_reverse, smg$m_reverse); END; END; {endif} wd_ptr := wd_ptr+1; END ELSE IF (key.term_code<>smg$k_trm_cr) AND (key.term_code<>smg$k_trm_f10) AND (key.term_code<>smg$k_trm_enter) THEN smg$ring_bell(menu_display); UNTIL (key.term_code=smg$k_trm_cr) OR (key.term_code=smg$k_trm_f10) OR (key.term_code=smg$k_trm_enter); upper_casing:=true; {restore getkey} END; PROCEDURE checkorwrong; {handles Check and Wrong options from menu} VAR lcWord : WordType; word_not_split : BOOLEAN; in_dictionary : BOOLEAN; col : INTEGER; our_ok_chars : SET OF CHAR; BEGIN IF (Verdict = 'C') {fiddles with semi-global verdict} THEN {very kludgy - probably needs a complete} BEGIN {recode from top to bottom...} Check(CorrectWord); IF length(correctword)=0 THEN verdict:='N' ELSE BEGIN IF yesanswer('Is the new word "'+CorrectWord+'" correct') THEN verdict:='Y' ELSE verdict:='N'; END; IF (verdict = 'N') THEN BEGIN IF yesanswer('Is the original word "'+ substr(ThisWord,1,index(ThisWord,' ')-1)+'" correct') THEN verdict:='Y' ELSE verdict:='N'; IF (verdict='Y') THEN BEGIN verdict:='I'; Insert (ThisWord, NewGoodWords); Insert ( ThisWord, IgnoreList ); IF guidanceNeeded THEN RecordGuidance ( ThisWord ); END END; END; IF (NOT (verdict IN ['Y','I'])) {i.e. "Wrong", "Edit" or "No" to Check} THEN BEGIN IF verdict='E' THEN BEGIN write_menu('Edit spelling:',' '+substr(ThisWord,1,index(ThisWord,' ')-1), vers:=false); smg$set_cursor_abs(menu_display, 1, 16); edit_word(ThisWord, correctWord, 16); END ELSE BEGIN write_menu('','Correct spelling: ',vers:=false); myReadln(correctWord); END; IF length(correctword)=0 THEN verdict:='@' {return to menu} END; IF verdict<>'@' THEN BEGIN lcword := CorrectWord; word_not_split := true; FOR col := 1 TO length(lcword) DO BEGIN IF lcword[col] IN upper_case_chars THEN lcword[col] := chr(ord(lcword[col])+32); IF (NOT(lcword[col] IN lower_case_chars)) AND (lcword[col]<>'''') {has he split the word?} THEN word_not_split := false; END; IF word_not_split THEN BEGIN in_dictionary := OccursInTree ( lcWord, IgnoreList ); IF NOT in_dictionary THEN in_dictionary := IsCommonWord ( lcWord ); IF NOT in_dictionary THEN in_dictionary := occurs ( pad(lcWord, ' ', 32) ); IF NOT in_dictionary THEN in_dictionary := find_in_goodfile ( lcWord ); IF NOT in_dictionary THEN BEGIN IF using_persdict THEN our_ok_chars := ['R','W','I','P','S','H'] ELSE our_ok_chars := ['R','W','I','S','H']; IF using_persdict THEN write_menu('`'+lcWord+''':', ' Right Wrong Ignore Skip Personal Help') ELSE write_menu('`'+lcWord+''':', ' Right Wrong Ignore Skip Help'); REPEAT key := getkey; IF (NOT (key.ch IN our_ok_chars)) AND (key.term_code<>smg$k_trm_help) THEN smg$ring_bell(menu_display); UNTIL (key.ch IN our_ok_chars) OR (key.term_code=smg$k_trm_help); IF key.term_code=smg$k_trm_help THEN BEGIN put_help('CHANGED_WORD.SPELL_HELP'); IF using_persdict THEN write_menu('`'+lcWord+''':', ' Right Wrong Ignore Skip Personal Help') ELSE write_menu('`'+lcWord+''':', ' Right Wrong Ignore Skip Help'); END ELSE BEGIN CASE key.ch OF 'H': BEGIN put_help('CHANGED_WORD.SPELL_HELP'); IF using_persdict THEN write_menu('`'+lcWord+''':', ' Right Wrong Ignore Skip Personal Help') ELSE write_menu('`'+lcWord+''':', ' Right Wrong Ignore Skip Help'); END; 'R': BEGIN update_disposition('Right'); insert(lcWord, NewGoodWords); {added_to_newgood := added_to_newgood+1;} insert(lcWord, IgnoreList ); END; 'P': IF using_persdict THEN BEGIN update_disposition('Personal'); persadd(lcWord); END; 'W': BEGIN update_disposition('Wrong'); verdict:='@'; END; 'I': BEGIN update_disposition('Ignore'); insert(lcWord, IgnoreList ); IF guidanceNeeded THEN RecordGuidance ( lcWord ); END; 'S': update_disposition('Skip'); END; {endcase} END; {endif} END; END; END; IF (NOT (verdict IN ['I','@'])) THEN {we did make a correction} BEGIN querycase; {check the case of replacement} InsertDouble(ThisWord, CorrectWord, Misspelled); {put in wrong/right list} updateline; {fix text line} verdict:='C' {part with an acceptable verdict} END END; PROCEDURE confirmquit; {make sure that quit is intentional} VAR option:keystroke; BEGIN write_menu('Quit options:',' Abandon Save Continue Help'); REPEAT option:=getkey; CASE option.ch OF 'A': GOTO 99; 'S': quit:=true; 'C': {do nothing}; 'H': put_help('QUIT.SPELL_HELP'); OTHERWISE BEGIN smg$ring_bell(menu_display); option.term_code:=7; END; END; UNTIL option.term_code<>7 END; PROCEDURE EvalType; {evaluate a new type for the file} VAR key : keystroke; (* prompted character *) newtype : esctype; (* new type value *) BEGIN write_menu('Available types:', ' Runoff Scribe Tex Issue Nroff vaxDoc Unknown '); REPEAT key := getkey; IF (NOT (key.ch IN ['R','S','T','I','N','D','U'])) THEN smg$ring_bell(menu_display); UNTIL (key.ch IN ['R','S','T','I','N','D','U']); CASE key.ch OF 'R': NewType := Runoff; 'S': NewType := Scribe; 'T': NewType := Tex; 'I': NewType := Issue; 'N': NewType := Nroff; 'U': NewType := Unknown; 'D': NewType := VAXDoc; END; IF NewType=escapemode THEN write_menu('','That''s no change, of course!',vers:=false) ELSE BEGIN escapemode := NewType; CASE escapemode OF runoff :smg$put_chars(status_display,'Embedded commands: Runoff',2,2,1); tex :smg$put_chars(status_display,'Embedded commands: TeX',2,2,1); scribe :smg$put_chars(status_display,'Embedded commands: Scribe',2,2,1); unknown:smg$put_chars(status_display,'Embedded commands: None',2,2,1); nroff :smg$put_chars(status_display,'Embedded commands: n/troff',2,2,1); issue :smg$put_chars(status_display,'Embedded commands: Issue',2,2,1); vaxdoc :smg$put_chars(status_display,'Embedded commands: VAX Doc',2,2,1); END; END; END; BEGIN {judge - finally...} REPEAT {main repeat loop for menu} contextscreen; IF using_persdict THEN write_menu('Options:', ' Right Wrong Personal Ignore Junk Check Guess Quit Help Edit Skip', vers:=false) ELSE write_menu('Options:', ' Right Wrong Ignore Junk Check Guess Quit Help Edit Skip', vers:=false); key:=getkey; IF key.term_code=smg$k_trm_down THEN BEGIN WHILE textline^.next<>NIL DO BEGIN oldword:=textline; textline:=textline^.next; dispose(oldword); END; verdict:='S'; END ELSE IF key.term_code=smg$k_trm_help THEN verdict := 'H' ELSE IF key.term_code>255 THEN verdict := chr(0) ELSE verdict := key.ch; CASE verdict OF {main menu} 'H': put_help('MAIN.SPELL_HELP'); 'G': BEGIN update_disposition('Guess'); IF guess {successful guess} THEN BEGIN querycase; {check for correct case} insertdouble(ThisWord, correctword, misspelled); updateline; {fix the text line} END ELSE {guessing failed} BEGIN {go back to main menu} verdict:='@'; {kluge to loop to menu} END; END; 'Q': BEGIN {quit the program} update_disposition('Quit'); confirmquit; END; 'P': IF using_persdict THEN BEGIN {put in personal dictionary} update_disposition('Personal'); persadd(ThisWord); END ELSE smg$ring_bell(menu_display); 'R': BEGIN {word is right} update_disposition('Right'); Insert (ThisWord, NewGoodWords); Insert ( ThisWord, IgnoreList ) END; 'W': BEGIN {word is wrong} update_disposition('Wrong'); checkorwrong; END; 'C': BEGIN {check in dictionary} update_disposition('Check'); checkorwrong; END; 'E': BEGIN {correct the word, rather than start} update_disposition('Edit'); { all over again, as with `wrong'} checkorwrong; END; 'S': update_disposition('Skip'); {forget the word entirely} 'I': BEGIN {ignore the word} update_disposition('Ignore'); insert(ThisWord,ignorelist); IF guidanceNeeded THEN RecordGuidance ( ThisWord ); END; 'J': BEGIN {a junk word - a serious problem in } update_disposition('Junk'); {Robin's standards work!} IF logging THEN BEGIN writeln(logfile,'line ',linenumber:4,': "', thisword:index(thisword,' ')-1, '" declared to be ''junk''!'); logged_something:=true; END; END; 'T': BEGIN update_disposition('Type'); EvalType; Verdict:='@'; {fudge return to this menu} END; '!': BEGIN writeln('IgnoreList is:'); print_tree(output, IgnoreList, 0); getkey; END; '?': BEGIN writeln('IgnoreList statistics are:'); summarise_tree(output, IgnoreList); getkey; END; OTHERWISE smg$ring_bell(menu_display); {complain} END; { case } smg$flush_buffer(pasteboard); {ensure any changes are displayed} UNTIL (quit) OR (verdict IN main_ok_chars); write_menu('','Checking...'); END; FUNCTION Unchecked (WordToFind : wordtype) : BOOLEAN; {checks newgood dictionary} VAR temp_display:unsigned; BEGIN IF NOT find_in_goodfile(ThisWord) THEN unchecked:=false ELSE BEGIN contextscreen; smg$create_virtual_display(2,screen_cols-2,temp_display,smg$m_border); smg$paste_virtual_display(temp_display,pasteboard,19,2); smg$put_line(temp_display,' This word has been entered by a user, '+ 'but has not yet been checked in'); smg$put_line(temp_display, ' the main dictionary. Use it at your own risk!'); smg$ring_bell(temp_display); IF yesanswer('Do you want to accept it as correct') THEN BEGIN unchecked:=true; update_disposition('Right'); Insert (WordToFind,IgnoreList); write_menu('','Checking...'); END ELSE unchecked:=false; smg$delete_virtual_display(temp_display); END; END; PROCEDURE CheckWord; {check in all dictionaries} VAR Found :BOOLEAN; Oldword:listptr; PROCEDURE repeaterror; {for errors that were already fixed} VAR temp_string:line; BEGIN contextscreen(pr:=false); smg$unpaste_virtual_display(error_display,pasteboard); smg$erase_display(error_display); smg$paste_virtual_display(error_display,pasteboard,9,2); writev(temp_string,linenumber:5); smg$put_line(error_display,'Line: '+temp_string+ ' '+ThisWord+' Change to: '+Correctword); IF yesanswer('Do you want to make this change') THEN BEGIN querycase; updateline; END ELSE BEGIN IF yesanswer('Do you want to change it to something else') THEN BEGIN write_menu('','Correct spelling: ',vers:=false); myReadln(correctWord); querycase; updateline END END; write_menu('','Checking...'); END; BEGIN {checkword} IF (textline^.length>1) OR do_single_letter_words THEN BEGIN ThisWord:=textline^.Name; IF NOT OccursInTree(ThisWord,IgnoreList) {have we checked it before?} THEN IF NOT (IsCommonWord(ThisWord)) {is it a common word?} THEN IF (Occurs(ThisWord)) {is it in any dictionary} THEN insert ( ThisWord, IgnoreList ) {put it into tree} ELSE BEGIN {check if already in MisSpelled List} SearchDouble(ThisWord, Misspelled, Found, CorrectWord); IF Found THEN repeaterror {It's definitely wrong} ELSE IF unchecked(ThisWord) {look at newgood words} THEN insert ( ThisWord, IgnoreList ) ELSE judge(textline) {needs user intervention} END; END; Oldword:=textline; {take word off the front of wordlist} TextLine := TextLine^.next; dispose(oldword); {clean up after ourselves} END; PROCEDURE WriteTree ( TreeName : Tree; {write the newgood tree to disk} got_a_tmp : BOOLEAN; {i.e. update newgood file} VAR tmp : word3s ); {types for use with getjpi} TYPE pointer_integer = ^INTEGER; username_array = PACKED ARRAY [1..12] OF CHAR; pointer_username_array = ^username_array; integer_32 = -32768..32767; jpi_item = PACKED RECORD buffer_length, (* length of buffer we're offering *) item_code : [WORD] integer_32; buffer_addr : pointer_username_array; return_length : pointer_integer; END; VAR jpi_list : PACKED ARRAY [1..2] OF jpi_item; i,duff : INTEGER; name_length : [WORD] integer_32; {our infamous procedure definitions} [asynchronous,EXTERNAL(sys$getjpiw)] FUNCTION getjpi ( %IMMED efn : unsigned := %IMMED 0; VAR pidadr : [VOLATILE] unsigned := %IMMED 0; prcnam : [class_s] PACKED ARRAY [$l1..$u1:INTEGER] OF CHAR := %IMMED 0; %REF itmlst : [unsafe] PACKED ARRAY [$l2..$u2:INTEGER] OF jpi_item; VAR iosb : [VOLATILE] ARRAY [$l3..$u3:INTEGER] OF INTEGER := %IMMED 0; {in STARLET, this is a $QUAD} %IMMED [unbound,asynchronous] PROCEDURE astadr := %IMMED 0; %IMMED astprm : unsigned := %IMMED 0) : INTEGER; EXTERNAL; BEGIN IF NOT got_a_tmp THEN BEGIN {not recursing - things need setting up} {to kick off, let's get some sort of name for who's running us} duff := lib$get_symbol ( 'real_name', tmp.user, name_length ); IF NOT (odd(duff)) THEN BEGIN {ah well - use process name} jpi_list[1].buffer_length := 15; jpi_list[1].item_code := jpi$_username; new(jpi_list[1].buffer_addr); new(jpi_list[1].return_length); jpi_list[2].buffer_length := 0; {these two provide a "terminating } jpi_list[2].item_code := 0; { zero longword" for the item list} duff := getjpi(itmlst:=jpi_list); tmp.user := jpi_list[1].buffer_addr^; name_length := jpi_list[1].return_length^; END; FOR i := name_length+1 TO 32 DO tmp.user[i] := ' '; duff := $asctim (timbuf:=tmp.date); {this gets a date and time for us} tmp.fnam := usable_file_name; {save file name too} END; IF (TreeName <> NIL) THEN BEGIN tmp.item:=treename^.Name; write(goodfile,tmp,error:=continue); IF (TreeName^.Left<>NIL) THEN WriteTree( TreeName^.Left, true, tmp ); IF (TreeName^.Right<>NIL) THEN WriteTree( TreeName^.Right, true, tmp ); END; END; PROCEDURE init; {miscellaneous initializations} VAR stat : INTEGER; ftype : linefix; {used in evaluating file type} file_param : linefix; {used in reading file names (surely cli$get_value needn't be defined the way it is?} BEGIN get_uic; NewGoodWords := NIL; Quit := FALSE; stat:=cli$present('PERSO'); {personal dict update mode} IF (stat=cli$_present) OR (stat=cli$_negated) THEN BEGIN using_persdict := (stat<>cli$_negated); IF NOT using_persdict THEN maintmode:=personal; END; IF maintmode<>personal THEN BEGIN stat:=cli$present('UPDAT'); {system dict update mode} IF stat=cli$_present THEN maintmode:=system ELSE BEGIN stat:=cli$present('CHECK'); {check a word mode} IF stat=cli$_present THEN maintmode:=checking; END; END; stat:=cli$present('FILES'); {see if we have a filename} IF stat=cli$_present THEN stat:=cli$get_value('FILES',param) ELSE param:=pad(' ',' ',80); stat := cli$present('OUPUT'); IF stat=cli$_negated THEN using_listing := false ELSE IF stat=cli$_present THEN BEGIN stat := cli$get_value('OUPUT', file_param); IF odd(stat) THEN BEGIN work_file := file_param; {fix up types...} named_listing := true; END; END; stat := cli$present('FTYPE'); IF stat=cli$_present THEN BEGIN stat:=cli$get_value('FTYPE',ftype); IF ftype='RUNOFF' THEN escapemode := runoff; IF (ftype='TEX') OR (ftype='LATEX') THEN escapemode := tex; IF (ftype='MSS') OR (ftype='SCRIBE') THEN escapemode := scribe; IF (ftype='NROFF') OR (ftype='TROFF') THEN escapemode := nroff; IF ftype='ISSUE' THEN escapemode := issue; IF (ftype='VAXDOC') OR (ftype='DOCUMENT') THEN escapemode := vaxdoc; END; stat:=cli$present('LOGGI'); {see if we want logging} logging:=(stat=cli$_present); stat:=cli$present('TESTI'); {see if we want a test run} IF stat=cli$_present THEN test_run:=true; {mark a test run} stat := cli$present('BUILD'); {to build a news section?} every_word_ok := (stat=cli$_present); stat := cli$present('SINGL'); {to do single letter words?} do_single_letter_words := (stat=cli$_present); IF using_persdict THEN main_ok_chars:=['P','R','S','E','I','W','C','G','J','T'] ELSE main_ok_chars:=['R','S','E','I','W','C','G','J','T']; stat := cli$present('GUIDE'); {guidance file?} guidanceNeeded := (stat=cli$_present); stat := cli$get_value('GUIDE', file_param); IF odd(stat) THEN BEGIN guidanceFileName := file_param; {fix up types} namedGuidanceFile := true; END; set_gigi; smg$create_virtual_keyboard(keyboard); smg$create_pasteboard(pasteboard); smg$control_mode(pasteboard,smg$m_minupd+smg$m_clear_screen+smg$m_notabs); smg$create_virtual_display(2,screen_cols-2,header_display); smg$create_virtual_display(3,screen_cols-2,status_display,smg$m_border); smg$create_virtual_display(3,screen_cols-2,error_display); smg$create_virtual_display(3,screen_cols-2,context_display,smg$m_border); smg$create_virtual_display(3,screen_cols-2,message_display,smg$m_border); smg$create_virtual_display(1,screen_cols,menu_display,smg$m_border); smg$create_virtual_display(5,screen_cols-2,guess_display,smg$m_border); smg$create_virtual_display(screen_rows-5,screen_cols,help_display); smg$create_virtual_display(screen_rows-5,screen_cols,personal_display); smg$create_virtual_display(1,screen_cols,top_display,smg$m_border); smg$paste_virtual_display(header_display,pasteboard,1,2); smg$paste_virtual_display(menu_display,pasteboard,screen_rows-1,1); smg$label_border(status_display,'Status',rendition_set:=smg$m_bold); smg$label_border(context_display,'Context',rendition_set:=smg$m_bold); smg$label_border(guess_display,'Guesses (ctrl-Z to stop)', rendition_set:=smg$m_bold); smg$set_out_of_band_asts(pasteboard,control_character_mask:=ast_mask, ast_routine:=%IMMED out_of_band_handler); smg$set_broadcast_trapping(pasteboard,%IMMED broadcast_handler); END; PROCEDURE byebye; {prints final statistics} BEGIN smg$unpaste_virtual_display(message_display,pasteboard); status_line(linenumber); IF every_word_ok THEN BEGIN writeln('IgnoreList statistics are:'); summarise_tree(output, IgnoreList); getkey; END; write_menu('','Spell checking finished. Press any key to continue...'); getkey; smg$unpaste_virtual_display(status_display,pasteboard); smg$unpaste_virtual_display(error_display,pasteboard); smg$unpaste_virtual_display(context_display,pasteboard); END; PROCEDURE flushrest; {dumps rest of file after a quit} BEGIN IF NOT(eof(document)) THEN BEGIN IF using_listing THEN BEGIN write_menu('', 'I''m copying the rest of the file without checking it...'); WHILE NOT(eof(document)) DO BEGIN readln(document,currline,error:=continue); writeln(listing,currline,error:=continue); IF status(listing)>0 THEN outerror END; END ELSE write_menu('','I''m ignoring the rest of the file...'); END; END; PROCEDURE maintain; {maintenance mode utilities} PROCEDURE nopriv; {complain if insufficient privilege} BEGIN write_menu('', 'You do not have enough privilege to update the main dictionaries!'); getkey; GOTO 99; END; PROCEDURE updatedict; {update mode} VAR done,deleteok:BOOLEAN; dummy:word1; temp_display:unsigned; PROCEDURE correct; {update words from newgood} VAR thisword : word3s; tmpword : wordtype; ch : CHAR; key : keystroke; i,userlen : INTEGER; wordlen : INTEGER; filelen : INTEGER; tmp1 : word1; tmp2 : word2; tmp3 : word3; duff : INTEGER; {for return from $asctim} time_word : PACKED ARRAY [1..23] OF CHAR; {ditto} PROCEDURE rightword; {insert word into main dict and delete from} BEGIN {newgood file} IF wordlen <= 8 THEN BEGIN tmp1.item:=substr(tmpword,1,8); write(dict1,tmp1,error:=continue); END ELSE IF wordlen <=16 THEN BEGIN tmp2.item:=substr(tmpword,1,16); write(dict2,tmp2,error:=continue); END ELSE BEGIN tmp3.item:=thisword.item; write(dict3,tmp3,error:=continue); END; delete(goodfile); END; PROCEDURE deletemain; {delete words from main dictionary} VAR tmplen : INTEGER; abandoned : BOOLEAN; successfully_deleted : BOOLEAN; BEGIN REPEAT write_menu('','What word do you want to delete: ',vers:=false); myreadln(tmpword); tmplen:=length(tmpword); IF tmplen=0 THEN abandoned:=true ELSE BEGIN abandoned:=false; IF tmplen<32 THEN tmpword:=pad(tmpword,' ',32); IF tmplen <= 8 THEN BEGIN tmp1.item:=substr(tmpword,1,8); findk(dict1,0,tmp1.item); successfully_deleted := NOT ufb(dict1); IF successfully_deleted THEN delete(dict1,error:=continue) ELSE unlock(dict1, error:=continue); END ELSE IF tmplen <=16 THEN BEGIN tmp2.item:=substr(tmpword,1,16); findk(dict2,0,tmp2.item); successfully_deleted := NOT ufb(dict2); IF successfully_deleted THEN delete(dict2,error:=continue) ELSE unlock(dict2, error:=continue); END ELSE BEGIN tmp3.item:=tmpword; findk(dict3,0,tmp3.item); successfully_deleted := NOT ufb(dict3); IF successfully_deleted THEN delete(dict3,error:=continue) ELSE unlock(dict3, error:=continue); END; IF NOT successfully_deleted THEN BEGIN write_menu('','`'+tmpword+''' isn''t in the dictionary in the '+ 'first place; press any key to continue', vers:=false); getkey; END; END; UNTIL abandoned; write_menu('Update Options:',' Right Wrong Ignore Delete Quit Help'); END; BEGIN {correct} smg$paste_virtual_display(temp_display,pasteboard,20,2); REPEAT thisword:=goodfile^; tmpword:=thisword.item; wordlen := index(tmpword,' ')-1; FOR i := 1 TO 32 DO IF thisword.user[i]<>' ' THEN userlen := i; filelen := index(thisword.fnam,' ')-1; IF filelen<0 THEN filelen := 32; smg$erase_display(temp_display); smg$put_chars(temp_display,' '+pad(tmpword,' ',32)+'>>> ',1,1); key:=getkey; CASE key.ch OF 'R': BEGIN smg$put_chars(temp_display,'Right'); rightword; END; 'W': BEGIN smg$put_chars(temp_display,'Wrong'); delete(goodfile); IF logging THEN BEGIN IF NOT logged_something THEN BEGIN {open log file} Open(logfile,'spell_dict:newgood.err',Unknown,error:=continue); extend(logfile,error:=continue); duff := $asctim(timbuf:=time_word); writeln(logfile,'=================================== ', time_word); logged_something := true; END; writeln(logfile, '"', tmpword:wordlen, '" deleted from NEWGOOD file', ' (inserted by user ''',thisword.user:userlen, ''' from file ''',thisword.fnam:filelen, ''' on ',thisword.date:17,')'); END; END; 'I': BEGIN smg$put_chars(temp_display,'Ignore'); deleteok:=false; END; 'D': BEGIN smg$put_chars(temp_display,'Delete'); deletemain; END; 'Q': BEGIN smg$put_chars(temp_display,'Quit'); smg$delete_virtual_display(temp_display); done:=true; deleteok:=false; END; 'H': BEGIN put_help('UPDATE.SPELL_HELP'); write_menu('Update Options:',' Right Wrong Ignore Delete Quit Help'); END; END; UNTIL key.ch IN ['R','W','I','Q','H']; IF key.ch<>'Q' THEN BEGIN get( goodfile, error := continue ); IF (ufb(goodfile)) THEN BEGIN write_menu('',' ... No more words in NEWGOOD file ...',false); END; END; END; BEGIN {updatedict} done:=false; deleteok:=true; open (dict1,filedir+'LEXIC08.DAT',history:=old, access_method:=KEYED,organization:=INDEXED,sharing:=readwrite, error:=continue); IF status(dict1)>0 THEN nopriv; dummy.item:='@ '; dict1^:=dummy; put(dict1,error:=continue); IF status(dict1)>0 THEN nopriv; findk(dict1,0,'@ '); delete(dict1,error:=continue); open (dict2,filedir+'LEXIC16.DAT',history:=old, access_method:=KEYED,organization:=INDEXED,sharing:=readwrite, error:=continue); IF status(dict2)>0 THEN nopriv; open (dict3,filedir+'LEXIC32.DAT',history:=old, access_method:=KEYED,organization:=INDEXED,sharing:=readwrite, error:=continue); IF status(dict3)>0 THEN nopriv; open (goodfile,filedir+gdfile, access_method:=keyed,organization:=INDEXED,history:=UNKNOWN, sharing:=readwrite,error:=continue); IF status(goodfile)>0 THEN openerror('new word file'); resetk(goodfile,0,error:=continue); write_menu('Update Options:',' Right Wrong Ignore Delete Quit Help'); smg$create_virtual_display(1,screen_cols-2,temp_display,smg$m_border); WHILE (NOT(done)) AND (NOT(ufb(goodfile))) DO correct; IF deleteok THEN BEGIN close(goodfile,error:=continue); open (goodfile,filedir+gdfile, access_method:=keyed,organization:=INDEXED,history:=NEW, sharing:=readwrite,error:=continue); IF status(goodfile)>0 THEN openerror('new word file'); close(goodfile,error:=continue); do_dcl(pad('set protection=w:rwe '+filedir+gdfile,' ',80)); END; close(goodfile,error:=continue); close(dict1,error:=continue); close(dict2,error:=continue); close(dict3,error:=continue); IF logging AND logged_something THEN close (logfile,error:=continue); END; PROCEDURE checkmode; {VMS check mode} VAR tmpline:line; tmpstr:wordtype; i:INTEGER; BEGIN open (dict1,filedir+'LEXIC08.DAT',history:=readonly, access_method:=KEYED,organization:=INDEXED,error:=continue, sharing:=readwrite); IF status(dict1)>0 THEN openerror('short word dictionary'); open (dict2,filedir+'LEXIC16.DAT',history:=readonly, access_method:=KEYED,organization:=INDEXED,error:=continue, sharing:=readwrite); IF status(dict2)>0 THEN openerror('medium word dictionary'); open (dict3,filedir+'LEXIC32.DAT',history:=readonly, access_method:=KEYED,organization:=INDEXED,error:=continue, sharing:=readwrite); IF status(dict3)>0 THEN openerror('long word dictionary'); IF using_persdict THEN BEGIN open (persdict,'sys$login:'+pdfile,history:=unknown, access_method:=KEYED,organization:=INDEXED,error:=continue, sharing:=readwrite); IF status(persdict)>0 THEN persdicterror; END; tmpline:=param; WHILE (index(tmpline,' ')=1) AND (length(tmpline)>1) DO tmpline:=substr(tmpline,2,length(tmpline)-1); IF length(tmpline)=1 THEN BEGIN write_menu('','Please enter the word you want to check: ',vers:=false); myreadln(tmpline); IF length(tmpline)<=32 THEN tmpline:=pad(tmpline,' ',33); END; tmpstr:=(substr(tmpline,1,32)); FOR i:=1 TO 32 DO IF tmpstr.body[i] IN upper_case_chars THEN tmpstr.body[i]:=chr(ord(tmpstr.body[i])+32); IF occurs(tmpstr) THEN write_menu('','"'+substr(tmpstr,1,index(tmpstr,' ')-1)+ '" was found. Press any key to continue...') ELSE write_menu('','"'+substr(tmpstr,1,index(tmpstr,' ')-1)+ '" was not found. Press any key to continue...'); getkey; close(dict1,error:=continue); close(dict2,error:=continue); close(dict3,error:=continue); IF using_persdict THEN close(persdict,error:=continue); END; PROCEDURE updatepers; {update personal dictionary} VAR key:keystroke; ch:CHAR; PROCEDURE listpers; {list personal dictionary} VAR wordnum:INTEGER; part1,part2:wordtype; i:INTEGER; BEGIN smg$unpaste_virtual_display(personal_display,pasteboard); smg$erase_display(personal_display); smg$paste_virtual_display(personal_display,pasteboard,3,1); wordnum:=1; IF ufb(persdict) THEN resetk(persdict,0,error:=continue); {wrap around} WHILE (wordnum MOD 17 <> 0) AND (NOT ufb(persdict)) DO BEGIN part1:=persdict^.item; {two column printing} get(persdict,error:=continue); IF NOT ufb(persdict) THEN part2:=persdict^.item ELSE part2:=''; get(persdict,error:=continue); smg$put_chars(personal_display,part1+' '+part2,wordnum+1,2); wordnum:=wordnum+1 END; END; PROCEDURE delpers; {delete a word from personal dict} VAR thisword:wordtype; tmpword:word3; BEGIN write_menu('','Enter the word you want to delete: ',vers:=false); myreadln(thisword); IF length(thisword)>0 THEN IF length(thisword)<32 THEN BEGIN tmpword.item:=pad(thisword,' ',32); findk(persdict,0,tmpword.item); delete(persdict,error:=continue); get(persdict,error:=continue); END ELSE BEGIN write_menu('', 'Word is not in personal dictionary! Press any key to continue...'); getkey END END; BEGIN {updatepers} open (persdict,'sys$login:'+pdfile,history:=unknown, access_method:=KEYED,organization:=INDEXED,error:=continue, sharing:=readwrite); IF status(persdict)>0 THEN persdicterror; listpers; REPEAT write_menu('Personal Dictionary Options:',' List Delete Menu Quit Help'); key:=getkey; ch:=key.ch; CASE ch OF 'L':listpers; 'D':delpers; 'M':;{nothing} 'Q':GOTO 99; 'H':put_help('PERSONAL.SPELL_HELP'); END; UNTIL ch = 'M'; smg$unpaste_virtual_display(personal_display,pasteboard); END; BEGIN {maintain} CASE maintmode OF system:updatedict; checking:checkmode; personal:updatepers; normal:{should never happen} END; closefiles; END; PROCEDURE proofread; BEGIN pasted:=false; Openfiles; ReadInCommonWrds; LineNumber := 0; write_menu('','Checking...'); status_line(0); WHILE (NOT eof(document)) AND (NOT quit) DO BEGIN ReadTextLine; WHILE (textline <> NIL) AND (NOT quit) DO checkword; IF using_listing THEN BEGIN writeln(listing,currline,error:=continue); IF status(listing)>0 THEN outerror; END; END; flushrest; WriteTree ( NewGoodWords, false, First_tmp ); closefiles; byebye; END; BEGIN {main program} stat := LIB$Get_Foreign(cmdline); cmd_lastnb := -1; FOR cmd_index := 1 TO length(cmdline) DO {find last `significant' character in command line} BEGIN IF substr(cmdline, cmd_index, 1)<>' ' THEN cmd_lastnb := cmd_index; END; IF cmd_lastnb < 0 THEN cmdline := 'Spell' ELSE cmdline := 'Spell ' + Substr(cmdline, 1, cmd_lastnb); stat := CLI$DCL_Parse(cmdline, %IMMED Spell_CLItable); IF stat=CLI$_normal THEN BEGIN Init; banner; IF maintmode=normal {we want to check a file} THEN BEGIN stat:=cli$present('FILES'); {see if we have a filename} IF stat=cli$_present THEN proofread ELSE REPEAT IF grp<=sys_uic THEN write_menu('Top level:',' Spell Check Update Personal Help Quit') ELSE write_menu('Top level:',' Spell Check Personal Help Quit'); selection:=getkey; CASE selection.ch OF 'S':proofread; 'C':BEGIN maintmode:=checking; maintain; END; 'U':IF grp<=sys_uic THEN BEGIN maintmode:=system; maintain; END; 'P':BEGIN maintmode:=personal; maintain; END; 'H':put_help('TOP.SPELL_HELP'); 'Q':{do nothing}; END; UNTIL selection.ch = 'Q' END ELSE maintain; {maintenance utilities} END; 99: smg$delete_pasteboard(pasteboard); IF using_listing THEN close(listing,disposition:=delete,error:=continue); {just in case} END.