(FILECREATED "22-JUL-83 14:00:13" <NEWLISP>SPELL.;1   46602

      changes to:  (FNS FIXSPELL)

      previous date: "10-MAR-83 21:35:14" <LISP>SPELL.;157)


(PRETTYCOMPRINT SPELLCOMS)

(RPAQQ SPELLCOMS [(FNS ADDSPELL ADDSPELL1 ADDSPELL2 MISSPELLED? FIXSPELL FIXSPELL1 FIXSPELL2 CHOOZ 
		       CHOOZ1 SKOR0 SKOR MOVETOP)
	(INITVARS (USERWORDS)
		  (SPELLINGS1 (QUOTE (DEFINEQ ARGLIST MOVD GETD FNTYP BREAK UNBREAK REBREAK TRACE 
					      BREAKIN MAKEFILE MAKEFILES LISTFILES FILES? WHEREIS 
					      CLEANUP PP PF EDITF EDITV EDITP ADVISE UNADVISE 
					      UNSAVEDEF RECOMPILE TCOMPL COMPILE BRECOMPILE BCOMPL 
					      MAPCAR MAPC LOAD LOADFROM LOADFNS TIME CLOSEF CLOSEALL 
					      OPENP OUTPUT INPUT OUTFILE INFILE LOGOUT PUTPROP 
					      REMPROP GETPROP SYSOUT CLISPIFY DWIMIFY EDITCALLERS 
					      FREEVARS CALLS)))
		  (SPELLINGS2 (QUOTE (GETPROP ADD1 AND APPEND ASSOC ATOM COND CONS COPY ELT EQ EQUAL 
					      ERROR ERSETQ EVAL FASSOC FMEMB FRPLACA FRPLACD FUNCTION 
					      GO IDIFFERENCE IGREATERP ILESSP IMINUS IPLUS ITIMES 
					      LENGTH LIST LISTP MAPC MAPCAR MAPCONC MEMB MEMBER NCONC 
					      NCONC1 NEQ NLISTP NLSETQ NULL NUMBERP OR PRINT PRIN1 
					      PROG PROGN PUTPROP QUOTE READ RETURN RPLACA RPLACD 
					      SELECTQ SETA SETQ SPACES SUB1 TERPRI ZEROP IF F/L 
					      VALUEOF FOR FETCH REPLACE CREATE GETPROP PUTPROP 
					      DIFFERENCE GREATERP LESSP PLUS)))
		  (SPELLINGS3 (QUOTE (BROKENFNS ADVISEDFNS NOTLISTEDFILES FILELST NOTCOMPILEDFILES 
						PROMPT#FLG CLISPIFYPRETTYFLG DWIMIFYCOMPFLG FILERDTBL 
						EDITRDTBL SYSPRETTYFLG NOSPELLFLG INITIALS NIL)))
		  (SPELLSTR1 "{spellseparator}")
		  (SPELLSTR2 "{spellignore}")
		  (FIXSPELLREL 70)
		  (FIXSPELLDEFAULT (QUOTE y))
		  (SKORLST1 (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL 
					NIL NIL NIL NIL)))
		  (SKORLST2 (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL 
					NIL NIL NIL NIL)))
		  DWIMKEYLST FIXSPELLKEYLST (FASTYPEFLG)
		  (RUNONFLG T)
		  (#USERWORDS 60)
		  (#SPELLINGS1 60)
		  (#SPELLINGS2 60)
		  (#SPELLINGS3 60)
		  (DWIMWAIT 10)
		  (RESPELLS)
		  (MODEL33FLG))
	(P (NCONC1 SPELLINGS1 SPELLSTR1)
	   (NCONC1 SPELLINGS2 SPELLSTR1)
	   (ATTACH SPELLSTR1 SPELLINGS3))
	(BLOCKS (FIXSPELLBLOCK MISSPELLED? FIXSPELL CHOOZ CHOOZ1 SKOR SKOR0 MOVETOP
			       (ENTRIES MISSPELLED? FIXSPELL CHOOZ SKOR0 SKOR MOVETOP)
			       (LOCALFREEVARS NCXWORD NCTWORD TAIL ALTFLG)
			       (GLOBALVARS CLISPCHARS CLISPFLG DWIMFLG EDITQUIETFLG FASTYPEFLG 
					   FCHARAR LASTWORD MODEL33FLG NOSPELLFLG RUNONFLG SKORLST1 
					   SKORLST2 SPELLINGS1 SPELLINGS2 SPELLSTATS1 SPELLSTR1 
					   SPELLSTR2))
		(FIXSPELL1 FIXSPELL1 FIXSPELL2
			   (GLOBALVARS APPROVEFLG COMMENTFLG CUTEFLG DWIMKEYLST DWIMWAIT REREADFLG 
				       RESPELLS RUNONSTATS SPELLSTATS SPELLSTATS1 VETOSTATS))
		(ADDSPELLBLOCK ADDSPELL ADDSPELL1 (ENTRIES ADDSPELL ADDSPELL1)
			       (GLOBALVARS #SPELLINGS2 #SPELLINGS3 #USERWORDS LASTWORD SPELLINGS1 
					   SPELLINGS2 SPELLINGS3 SPELLSTR1 SPELLSTR2 USERWORDS))
		(NIL ADDSPELL2 (GLOBALVARS SPELLSTR2])
(DEFINEQ

(ADDSPELL
  [LAMBDA (X SPLST N)

          (* Updates appropriate spellings lists as follows: if SPLST is NIL, adds to 
	  USERWORDS and SPELLINGS2; -
	  if SPLST is 0, just adds to USERWORDS; -
	  if SPLST is 1, adds to SPELLINGS1; -
	  if SPLST is 2, adds to SPELLINGS2; -
	  if SPLST is 3, adds to USERWORDS and SPELLINGS3.
	  -
	  -
	  SPELLINGS1 is the list of functions used in an APPLY context, e.g. MAKEFILE,
	  TCOMPL, DEFINEQ. SPELLINGS2 is the list of functions used in an EVAL 
	  context, e.g. CONS, AND, RETURN. SPELLINGS3 is a list of variables.
	  USERWORDS is a list of both functions and variables that the user 
	  references.)


    (AND (LITATOM X)
	 (SELECTQ SPLST
		  ((NIL 0)
		    

          (* DEFINE uses SPLST NIL, adds word to SPELLINGS2 because some user function
	  must call it. However, it might not be a top-level function, so it isn't 
	  added to SPELLINGS1 until used in that way.
	  -
	  SPLST 0 is for LOAD/PROP, and for use from EDITA, PRINTSTRUCTURE, etc. 
	  doesn't add it to SPELLINGS2 since have no indication that the function will
	  be called by the user.)


		    (SETQ USERWORDS (ADDSPELL1 X USERWORDS #USERWORDS))
		    (AND (NULL SPLST)
			 (SETQ SPELLINGS2 (ADDSPELL1 X SPELLINGS2 #SPELLINGS2)))
		    (SETQ LASTWORD X))
		  (1 

          (* Called from LISPX on APPLY inputs, add to permanent section, i.e. never 
	  forgets X.)


		     (SETQ SPELLINGS1 (ADDSPELL1 X SPELLINGS1)))
		  (2 

          (* Called from LISPX on EVAL inputs, never forgets X.
	  Not however that words are added to temporary section of SPELLINGS2 for 
	  TYPE=NIL or TYPE=0.)


		     (SETQ SPELLINGS2 (ADDSPELL1 X SPELLINGS2)))
		  ((T 3)
		    

          (* Called from LISPX inputs consisting of just a variable, or from SAVESET, 
	  i.e. any call to RPAQ or RPAQQ, or any call to SET or SETQ via LISPX, or 
	  from EDITV.)


		    (SETQ USERWORDS (ADDSPELL1 X USERWORDS #USERWORDS))
		    (SETQ SPELLINGS3 (ADDSPELL1 X SPELLINGS3 #SPELLINGS3))
		    (SETQ LASTWORD X))
		  (COND
		    ((LISTP SPLST)
		      (ADDSPELL1 X SPLST N))
		    (T (ERROR (QUOTE "bad addspell type:")
			      SPLST T])

(ADDSPELL1
  [LAMBDA (WORD SPLST N)                                    (* wt: " 9-OCT-78 00:37")

          (* SPLST is divided into two sections, permanent and temporary, separated by NIL. Words are never forgotten from the
	  permanent section. A maximum of N words are allowed in the temporary section. When a correction occurs, the word is 
	  moved to the front of the list, hence putting it in the permanent section. -
	  When ADDSPELL1 is called with N=NIL, words are added at the end of the permanent section, i.e. just before the NIL.
	  Otherwise they are added at the beginning of the temporary section, and if there are more than N words in the 
	  temporary list, the last is deleted.)


    [COND
      ((NULL SPLST)
	(SETQ SPLST (LIST SPELLSTR1 WORD)))
      ((AND (NEQ WORD (CAR SPLST))
	    (NEQ WORD (CADR SPLST)))
	                                                    (* Loop begins with third element.)
	(PROG ((L1 SPLST)
	       (L2 (CDDR SPLST))
	       L3 M)

          (* L1 stays two behind L2 so that the last element of SPLST can be deleted.)


	      (COND
		((EQ (CAR SPLST)
		     SPELLSTR1)
		  (SETQ L3 SPLST)
		  (SETQ M 1)
		                                            (* L2 has already skipped one of the
							    temporary words.))
		((EQ (CADR SPLST)
		     SPELLSTR1)
		  (SETQ L3 SPLST)
		  (SETQ M 0)))

          (* Special check necessary because USERWORDS starts off with NIL first, i.e.
	  no permanent USERWORDS. If NIL not noticed, length won't be counted and 
	  nothing will ever be deleted.)


	  LP  (COND
		((NULL L2)
		  (GO OUT))
		((EQ WORD (CAR L2))
		  (COND
		    ((NULL L3)
		                                            (* WORD is already in permanent 
							    section.))
		    ((NULL N)
		      

          (* WORD is in temporary section and would have been added to permanent 
	  section. Add it to permanent and erase from temporary.)


		      (FRPLACD (CDR L1)
			       (CDR L2))
		      (FRPLACD L2 (CDR L3))
		      (FRPLACD L3 L2))
		    (T 

          (* WORD is in temporary section and would have been added to temporary 
	  section. MOVE it to front of temporary section.)


		       (FRPLACD (CDR L1)
				(CDR L2))
		       (SETQ L3 (CDR L3))
		       (FRPLACD L2 (CDR L3))
		       (FRPLACD L3 L2)))
		  (RETURN))
		((EQ (CAR L2)
		     SPELLSTR1)
		  (SETQ L3 (CDR L1))
		                                            (* CAR of L3 is the last member of 
							    the permanent section.)
		  (SETQ M 0)))
	      (SETQ L1 (CDR L1))
	      (SETQ L2 (CDR L2))
	      (AND M (ADD1VAR M))                           (* M will be the length of temporary
							    section)
	      (GO LP)
	  OUT (COND
		((NULL L3)
		                                            (* NIL not found. Occurs if user is maintaining own 
												     |
							    spelling list and not using temporary/permanent 
												     |
							    conventions.)
		  (NCONC1 L1 WORD))
		[(NULL N)
		                                            (* Add at end of permanent section.)
		  (RPLNODE L3 (CAR L3)
			   (CONS WORD (CDR L3]
		((IGREATERP M N)
		                                            (* Add at beginning of temporary section, delete 
												     |
							    (AND REUSE) last element of temporary section.)
		  (RPLNODE (CDR L1)
			   WORD
			   (CDDR L3))
		  (RPLNODE (CDR L3)
			   (CADR L3)
			   (CDR L1))
		  (FRPLACD L1 NIL)
		                                            (* Not worth while to make the deletion of last elemetn 
												     |
							    undoable.))
		(T (RPLNODE (CDR L3)
			    (CADR L3)
			    (CONS WORD (CDDR L3)))
		                                            (* Add at beginning of temporary section.)))
	      (AND LISPXHIST (UNDOSAVE (LIST (QUOTE ADDSPELL2)
					     WORD SPLST)
				       LISPXHIST]
    SPLST])

(ADDSPELL2
  [LAMBDA (WORD SPLST)                                      (* wt: " 8-OCT-78 23:19")
    (PROG (TEM)
          (AND (SETQ TEM (FMEMB WORD SPLST))
	       (/RPLACA TEM SPELLSTR2])

(MISSPELLED?
  [LAMBDA (XWORD REL SPLST FLG TAIL FN)                     (* wt: "25-APR-78 12:26")
                                                            (* MISSPELLED? can be used when XWORD may in fact be all
							    right. FIXSPELL should be used if you know XWORD is 
							    wrong.)
    (PROG NIL                                               (* REL is between 0 and 100 and indicates percentage.)
          (RETURN (COND
		    ((OR (NULL XWORD)
			 (EQ XWORD (QUOTE )))
		      (LISPXWATCH SPELLSTATS1)
		      (PRIN1 (QUOTE =)
			     T)
		      (PRINT LASTWORD T T))
		    ((COND
			((NULL FN)
			  (FMEMB XWORD SPLST))
			(T (APPLY* FN XWORD)))
		      XWORD)
		    (T (FIXSPELL XWORD REL SPLST FLG TAIL FN])

(FIXSPELL
  [LAMBDA (XWORD REL SPLST FLG TAIL FN TIEFLG DONTMOVETOPFLG FROMDWIM APPROVALFLG)
                                   (* lmm "22-JUL-83 13:55")

          (* If FLG is T, XWORD is printed to left of = sign. -
	  CLST is used when FIXSPELL is called from WTFIX. In this case, if TYPE-IN? is NIL, XWORD is printed, and a -> is 
	  used instead of =. In addition, if FAULTFN is not NIL, (IN FAULTFN) is also printed as part of the message.
	  If CLST is a list, it is a DUNPACK of XWORD, since in most cases WTFIX will already have computed this list.
	  FLG is used to specify other types of messages besides ->. If TAIL is supplied, and word is equal to CAR of it, the 
	  correction will be smahed into TAIL. If TAIL is non NIL, runon corrections will be attempted.
	  (If TAIL=T, and a runon corection is approved, the dotted pair is returned as the value.) If FLG=NO-MESSAGE, the 
	  correction is returned without asking for approval.)


    (AND DWIMFLG (NEQ NOSPELLFLG T)
	 (OR (NULL NOSPELLFLG)
	     (NULL FROMDWIM)
	     (EVQ TYPE-IN?))
	 (OR (LISTP SPLST)
	     (ARRAYP SPLST))
	 (OR (LITATOM XWORD)
	     (STRINGP XWORD))
	 (PROG ((TLST (DCHCON XWORD SKORLST1))
		X TEM (NDBLS 0))
	       (COND
		 ((NULL REL)
		   (SETQ REL FIXSPELLREL)))
	       [COND
		 ((NULL XWORD)
		   (RETURN NIL))
		 ([AND (LISTP SPLST)
		       (NOT (STACKP (CAR SPLST]
		   (COND
		     ((SETQ TEM (ASSOC XWORD SPLST))
		       (SETQ X (LIST (CAR TEM)
				     (CDR TEM)))
		       (GO LP2))
		     ((NOT (U-CASEP XWORD))
		       (SETQ TEM (U-CASE XWORD))
		       (COND
			 [(OR (AND (OR (EQ FN (QUOTE GETD))
				       (EQ SPLST SPELLINGS1)
				       (EQ SPLST SPELLINGS2))
				   (FGETD TEM))
			      (FMEMB TEM SPLST))
			   (SETQ X TEM)
			   (COND
			     ((AND FROMDWIM (NULL TYPE-IN?))
			       (GO OUT))
			     (T (GO OUT1]
			 ((LISTP (SETQ TEM (FASSOC TEM SPLST)))

          (* reason for listp is that some entries on splst will not be lists, and is possible to get a match on the first 
	  entry of their property list, especially when misspelling NIL. the "right" way to do this would be with a SOME but 
	  is much less efficient.)


			   (SETQ X (LIST (CAR TEM)
					 (CDR TEM)))
			   (COND
			     ((NOT (AND FROMDWIM (NULL TYPE-IN?)))
			       (SETQQ FLG NO-MESSAGE)))
			   (GO LP2]
	       (COND
		 ((AND (EQ XWORD (QUOTE ))
		       (OR (NULL FROMDWIM)
			   (EVQ TYPE-IN?)))
                                   (* TYPE-iIN? is bound in WTFIX.)
		   (SETQ X LASTWORD)
		   (FIXSPELL1 XWORD LASTWORD NIL FROMDWIM)
		   (GO OUT1))
		 ((AND [SETQ TEM (FASSOC XWORD (LISTGET1 LISPXHIST (QUOTE RESPELLS]
		       (FMEMB (CDR TEM)
			      SPLST))
                                   (* Already made this correctionthis event.)
		   (SETQQ APPROVALFLG NEEDNOTAPPROVE)
		   (SETQ X (CDR TEM))
		   (GO LP2)))
	       (SETQ X TLST)
	   LP  (COND
		 ((NULL X)
		   (GO A))
		 ((AND (EQ (CAR X)
			   27)
		       (SETQ TEM (CDR X)))

          (* 27 Is alt-mode. for terminal alt modes, we call CHOOZ since this also handles the case where ther are 
	  misspellings in the leading characters.)


		   (SETQ TLST (DUNPACK XWORD SKORLST1))
		   (GO ALT))
		 ((EQ (CAR X)
		      TEM)
		   (SETQ NDBLS (ADD1 NDBLS)))
		 (T (SETQ TEM (CAR X))
                                   (* TEM keeps track of the previous character.)
		    ))
	       (SETQ X (CDR X))
	       (GO LP)
	   A   (COND
		 ((NULL MODEL33FLG)
                                   (* P,L,N,and O are on the same keys as @ \ ↑ and ← only on model 33's.)
		   (GO LP1)))
	       (SETQ X (SELECTQ (CAR TLST)
				(64 
                                   (* @)
				    (QUOTE P))
				(92 
                                   (* \)
				    (QUOTE L))
				(94 
                                   (* ↑)
				    (QUOTE N))
				(95 
                                   (* ←)
				    (QUOTE O))
				(GO LP1)))
	       [SETQ X (PACK (CONS X (CDR (DUNPACK XWORD SKORLST2]
	       (COND
		 ([AND FN (NULL (COND
				  ((EQ FN (QUOTE GETD))
				    (FGETD X))
				  (T (APPLY* FN X]
		   (GO LP1))
		 ((OR (NLISTP SPLST)
		      (FMEMB X SPLST))
		   (GO OUT))
		 (FN 

          (* Thus if a XWORD is misspelled by having its first character changed from p to @, l to \, n to or o to ←, and 
	  satisfies FN, it will be corrected even if not on the spelling list, and added to the list.)


		     (ATTACH X SPLST)
		     (GO OUT)))
	   LP1 (SETQ X (CHOOZ TLST REL SPLST TAIL FN TIEFLG NDBLS FROMDWIM))
	   LP2 [COND
		 ((NULL X)
		   (RETURN NIL))
		 ((OR (EQ TIEFLG (QUOTE ALL))
		      (EQ TIEFLG (QUOTE LIST))
		      (EQ TIEFLG (QUOTE EVERYTHING)))
		   (RETURN X))
		 ((LISTP X)
		   (RETURN (COND
			     [(LISTP (CDR X))
                                   (* synonym correction. XWORD is identical with CAR of X.)
			       (COND
				 ((OR (EQ XWORD (CAR X))
				      (EQ FLG (QUOTE NO-MESSAGE)))
                                   (* no approval necessary)
				   (SETQ X (CADR X))
				   (GO OUT1))
				 ((SETQ TEM (FIXSPELL1 XWORD (CAR X)
						       FLG FROMDWIM APPROVALFLG))
                                   (* e.g. synonym is S.T. but XWORD is S.TT.)
				   [SETQ X (COND
				       ((LISTP TEM)
                                   (* user specified new value via USING)
					 (CAR TEM))
				       (T (CADR X]
				   (GO OUT1]
			     ((NULL TAIL)
                                   (* value of form (a . b) returned by chooz means runon correction)
			       NIL)
			     ((EQ FLG (QUOTE NO-MESSAGE))
			       X)
			     ([SETQ TEM (FIXSPELL1 XWORD (COND
						     ((LISTP (CAR X))
                                   (* both a runon and synonym involved, e.g. user types WHERE, and 
				   (WHE . SY) on spelling list. fixpsspell1 asks WHERE= WHE RE?)
						       (CONS (CAAR X)
							     (CDR X)))
						     (T X))
						   FLG FROMDWIM (OR APPROVALFLG (QUOTE MUSTAPPROVE]
                                   (* Runon correction.)
			       (COND
				 ((LISTP TEM)
                                   (* user typed in a value. no run on)
				   (SETQ X (CAR TEM))
				   (GO OUT1))
				 ((AND (LISTP TAIL)
				       (EQ XWORD (CAR TAIL)))
                                   (* Smash TAIL and eturn the first word)
				   (/RPLNODE TAIL (COND
					       ((LISTP (CAR X))
						 (CADAR X))
					       (T (CAR X)))
					     (CONS (CDR X)
						   (CDR TAIL)))
				   (CAR TAIL))
				 [(LISTP TEM)
				   (COND
				     ((CDR TEM)
				       (CONS (CAR TEM)
					     (CADR TEM)))
				     (T (CAR TEM]
				 (T 
                                   (* Return the dotted pair)
				    X)))
			     ((IGREATERP (CHOOZ1 (NCHARS XWORD)
						 [NCHARS (COND
							   ((LISTP (CAR X))
							     (CAAR X))
							   (T (CAR X]
						 (NCHARS (CDR X)))
					 REL)
                                   (* e.g. the correction (BREAK . X) is offered for BREAKX this asks whether BREAK 
				   is a valid correction for BREAKX)
			       (SETQ X (CAR X))
			       (GO LP2]
	   OUT (COND
		 ((EQ FLG (QUOTE NO-MESSAGE))
		   (RETURN X))
		 [(SETQ TEM (FIXSPELL1 XWORD X FLG FROMDWIM APPROVALFLG))
                                   (* Prints appropriate message to user.)
		   (COND
		     ((LISTP TEM)
		       (SETQ X (CAR TEM))
		       (ADDSPELL X SPLST))
		     ([AND (NULL DONTMOVETOPFLG)
			   (LISTP (CDR (LISTP SPLST]
		       (MOVETOP X SPLST]
		 (T (RETURN NIL)))
	   OUT1(AND (LISTP TAIL)
		    (EQ XWORD (CAR TAIL))
		    (/RPLNODE TAIL X (CDR TAIL)))
	       (RETURN X)
	   ALT                     (* Alt-mode matching.)
	       [RESETVARS ((EDITQUIETFLG T))
		          (RETURN (PROG ((L SPLST)
					 (GENFN (AND (ARRAYP SPLST)
						     (ELT SPLST 1)))
					 (GENERATOR (AND (STACKP (CAR SPLST))
							 SPLST)))
				        (SETQ X NIL)
				    LP3 [COND
					  [GENFN (COND
						   ((NULL (SETQ TEM (APPLY* GENFN SPLST)))
						     (RETURN]
					  [GENERATOR (COND
						       ((EQ (SETQ TEM (GENERATE GENERATOR))
							    GENERATOR)
							 (RELSTK (CDR GENERATOR))
							 (RETURN]
					  ((NULL L)
					    (RETURN))
					  ((NULL (SETQ TEM (CAR L)))
					    (SETQ L (CDR L))
					    (GO LP3))
					  (T (SETQ L (CDR L]
				        [COND
					  ([AND (EDIT4E1 TLST (DUNPACK TEM SKORLST2))
						(OR (NULL FN)
						    (COND
						      ((EQ FN (QUOTE GETD))
							(FGETD TEM))
						      (T (APPLY* FN TEM]
					    (AND GENFN (STRINGP TEM)
						 (SETQ TEM (MKATOM TEM)))
                                   (* because the generator function may (frequently does) reuse the string it 
				   reutnrs.)
					    (COND
					      ((OR (EQ TIEFLG (QUOTE ALL))
						   (EQ TIEFLG (QUOTE LIST))
						   (EQ TIEFLG (QUOTE EVERYTHING)))
						(SETQ X (CONS TEM X)))
					      (TIEFLG (SETQ X TEM))
					      (X 
                                   (* Already a match, therefore ambiguous.)
						 (PRINT (QUOTE ambiguous)
							T)
						 (SETQ X NIL)
						 (RETURN))
					      (T (SETQ X TEM]
				        (GO LP3]
	       (GO LP2])

(FIXSPELL1
  [LAMBDA (WORD X FLG FROMDWIM APPROVALFLG DEFAULT)
                                   (* lmm " 6-APR-82 23:56")
                                   (* Performs interaction with user associated with a spelling or other corretion.)
    (PROG ([LISPXHIST (AND LISPXHIST (CONS (QUOTE *LISPXPRINT*)
					   (CONS NIL LISPXHIST]
	   (VAL T)
	   MESSFLG BUFS TEM)

          (* LISPXHIST is rebound as we don't want to include any DWIM messages if the change isn't actually performed, e.g. 
	  the user says NO. Therefore, we want to have LISPXPRIN1 et al save the output on a local LISPXHIST, and then 
	  transfer it all over to the real LISPXHIST if the correction goes through.)


          (AND (EQ WORD X)
	       (ERROR!))
          (COND
	    ((NEQ (POSITION T)
		  0)
	      (LISPXTERPRI T)
	      (TERPRI T)))
          (COND
	    ((OR (SETQ MESSFLG (OR (STRINGP WORD)
				   (STRINGP X)))
		 (EQ RESPELLS T))
                                   (* Dont keep respells.)
	      )
	    ((OR REREADFLG (STRPOS (QUOTE "")
				   WORD))
                                   (* Spelling completion)
	      )
	    ([OR (LISTP X)
		 (NULL (SETQ TEM (FASSOC X RESPELLS]
	      (SETQ RESPELLS (CONS (LIST X WORD)
				   RESPELLS)))
	    (T (NCONC1 TEM WORD)))
          (COND
	    ([AND (NEQ APPROVALFLG (QUOTE MUSTAPPROVE))
		  (COND
		    (FROMDWIM (AND TYPE-IN? (NULL MESSFLG)))
		    (T (NULL FLG]

          (* This is the case where the correction is a spelling correction (as inidcated by MESSFLG being NIL), and no 
	  approval is needed. i.e. FIXSPELL1 is just going to print = followed by the word.)


	      (AND (OR (EQ REREADFLG (QUOTE T))
		       FLG)
		   (PRIN2 WORD T T))
	      (PRIN1 (QUOTE =)
		     T)
	      (FIXSPELL2 X)
	      (AND (EQ TEM 2)
		   (PRIN1 (QUOTE "You seem to be having a lot of trouble typing that!
")
			  T))
	      (GO OUT1)))
          (COND
	    ([AND (NEQ APPROVALFLG (QUOTE MUSTAPPROVE))
		  (COND
		    ((NULL FROMDWIM)
		      (OR (NULL FLG)
			  (NULL APPROVEFLG)))
		    (T 

          (* OR is true if approval is required. NOte that even if APPROVEFLG is T, when there are two interpretations to a 
	  correction, as indicated by CLISPCHANGES not being NIL, always aks approval.)


		       (NULL (OR (AND (NULL TYPE-IN?)
				      APPROVEFLG)
				 CLISPCHANGES]
	      (SETQQ APPROVALFLG NEEDNOTAPPROVE)))
          [COND
	    ((OR (EQ APPROVALFLG (QUOTE MUSTAPPROVE))
		 (AND (NEQ APPROVALFLG (QUOTE NEEDNOTAPPROVE))
		      APPROVEFLG))
                                   (* Want to clear out LINUF and SYSBUF to prevent CLBUFS from misakenly returning 
				   left over typeahead from a previous CLEARBUF.)
	      (LINBUF)
	      (SYSBUF)             (* The extra argument to CLBUFS prevents READBUF 
				   (LISPX'S buffer) from being cleared.)
	      (SETQ BUFS (CLBUFS NIL T READBUF]
          (FIXSPELL2 WORD T)
          (COND
	    ((AND FROMDWIM (NULL TYPE-IN?))
	      (FIXPRINTIN FAULTFN T)
	      (LISPXPRIN1 (OR FLG (QUOTE " -> "))
			  T))
	    (T (LISPXPRIN1 (COND
			     ((AND FLG (NEQ FLG T))
			       FLG)
			     (T (QUOTE =)))
			   T)      (* E.g. For Shall I load ... message, FLG is "" for unary minus it is " ")
	       ))
          (AND NIL (STRINGP WORD)
	       (STRINGP X)
	       (OR (NULL FLG)
		   (EQ FLG T))
	       (NOT (STREQUAL WORD (QUOTE "")))
	       (LISPXTERPRI T))

          (* On corrections where both left and right are strings, and FLG is normal (thereby xcluding the TREAT AS CLISP 
	  case) print the strings on separate lnes for readability.)


          (COND
	    ((EQ APPROVALFLG (QUOTE NEEDNOTAPPROVE))
	      (FIXSPELL2 X)
	      (GO OUT)))
          (FIXSPELL2 X T)
          [SETQ VAL (ASKUSER (AND DWIMWAIT (COND
				    (MESSFLG 

          (* MESSFLG would be NIL for straight spelling correction. This says that the correction involves an 8 or a 9, or 
	  asks some question about CLISP. User will probably need more time to think about it in this case.)


					     (ITIMES 3 DWIMWAIT))
				    (T DWIMWAIT)))
			     (COND
			       (DEFAULT)
			       ([AND (LISTP X)
				     (OR (ILESSP (SETQ TEM (NCHARS (CAR X)))
						 3)
					 (NOT (IGREATERP TEM (NCHARS (CDR X]
                                   (* Runon correction. Defaut is NO if less than three characters in first word, or
				   first word is not greater than second in length)
				 (QUOTE n))
			       (T FIXSPELLDEFAULT))
			     (QUOTE " ?  ")
			     (COND
			       (FROMDWIM DWIMKEYLST)
			       (T FIXSPELLKEYLST]
          (AND BUFS (BKBUFS BUFS))
          (SELECTQ VAL
		   ((Y y)
		     (SETQ VAL T))
		   (N (LISPXWATCH VETOSTATS)
                                   (* If value returned was 'n' as opposed to 'N', means defaulted to NO, not 
				   vetoed.)
		      (RETURN NIL))
		   (n (RETURN NIL))
		   (SETQ X (CAR VAL)))
          (LISPXTERPRI T NIL NIL T)
                                   (* Adds a TERPRI to history list if LISPXPRINTFLG is T, but does not actually 
				   print a carriage return.)
      OUT (COND
	    ((CADR LISPXHIST)
	      (LISPXPUT (QUOTE *LISPXPRINT*)
			(CADR LISPXHIST)
			T
			(CDDR LISPXHIST))

          (* Makes the print information part of LISPXHIST. Before it was on a property that ws just consed onto the front.
	  This will also add it to any other print information.)


	      ))
      OUT1[AND FROMDWIM LISPXHIST (NULL TYPE-IN?)
	       (NEQ (CAR SIDES)
		    (QUOTE CLISP% ))
	       (SETQ SIDES (LIST (QUOTE CLISP% )
				 (LIST COMMENTFLG (CADR LISPXHIST)
				       SIDES]

          (* This marks the side information and print information as of the beginning of this correction.
	  For usefor selective undoing. CADR of LISPXHIST (which was rebound here), will be the beginning of the PRINT 
	  information, which if approved, will be NCONCed onto the print informaion for this event.)


          (COND
	    (MESSFLG (RETURN VAL))
	    (FROMDWIM (LISPXWATCH SPELLSTATS)
		      (AND LISPXHIST (LISPXPUT (QUOTE RESPELLS)
					       (LIST (CONS WORD X))
					       T LISPXHIST)))
	    (T (LISPXWATCH SPELLSTATS1)))
          (AND (LISTP X)
	       (LISPXWATCH RUNONSTATS))
          (RETURN VAL])

(FIXSPELL2
  [LAMBDA (X FLG)                                           (* wt: 15-JUL-76 20 53)
    (COND
      ((LISTP X)
	(MAPRINT (COND
		   ((AND (CDR X)
			 (NLISTP (CDR X)))
		     (LIST (CAR X)
			   (CDR X)))
		   (T X))
		 T NIL NIL NIL [FUNCTION (LAMBDA (X)
		     (COND
		       ((STRINGP X)
			 (LISPXPRIN1 X T))
		       (T (LISPXPRIN2 X T T]
		 T))
      ((STRINGP X)
	(LISPXPRIN1 X T))
      (T (LISPXPRIN2 X T T)))
    (COND
      ((NULL FLG)
	(LISPXTERPRI T])

(CHOOZ
  [LAMBDA (XWORD REL SPLST TAIL FN TIEFLG NDBLS FROMDWIM)
                                   (* DD: "17-Dec-81 14:14")
    [COND
      ((NLISTP XWORD)              (* When called from FIXSPELL, XWORD is already a CHCON lst.)
	(SETQ XWORD (CHCON XWORD]
    (PROG ((NCXWORD0 (FLENGTH XWORD))
	   NCXWORD NCTWORD TWORD TWORD1 TWORD2 TEM SC VAL (GENFN (AND (ARRAYP SPLST)
								      (ELT SPLST 1)))
	   (GENERATOR (AND (STACKP (CAR SPLST))
			   SPLST))
	   ALTFLG)
          [AND (NULL NDBLS)
	       (SETQ NDBLS 0)
	       (MAPC XWORD (FUNCTION (LAMBDA (X)
			 (COND
			   ((EQ X TEM)
			     (SETQ NDBLS (ADD1 NDBLS)))
			   (T (SETQ TEM X]
                                   (* Counts number of (possibly) doubled characters)
          (SETQ ALTFLG (EQ (CAR (LAST XWORD))
			   27))    (* xword ends in an alt-mode. means k to call skor even if testword is much 
				   longer.)
      LP  [COND
	    [GENFN 

          (* this provides a way of giving the spelling corrector a generating function intead of a spelling list.
	  the generatng function can keep its 'state' in one of the other cells of the array. when it returns a value of NIL 
	  for the 'next' element, the spelling lists is assume xhausted.)


		   (COND
		     ((NULL (SETQ TWORD (APPLY* GENFN SPLST)))
		       (GO OUT]
	    [GENERATOR (COND
			 ((EQ (SETQ TWORD (GENERATE GENERATOR))
			      GENERATOR)
			   (RELSTK (CDR GENERATOR))
			   (GO OUT]
	    ((NULL SPLST)
	      (GO OUT))
	    ((NLISTP SPLST)
	      (HELP "SMASHED SPELLING LIST" SPLST))
	    ((OR (EQ (SETQ TWORD (CAR SPLST))
		     SPELLSTR1)
		 (EQ TWORD SPELLSTR2))
                                   (* marker.)
	      (SETQ SPLST (CDR SPLST))
	      (GO LP))
	    (T (SETQ SPLST (CDR SPLST]
          [COND
	    ((LISTP TWORD)         (* Synonym feature.)
	      (SETQ TWORD1 (CAR TWORD))
	      (SETQ TWORD2 (CDR TWORD)))
	    (T (SETQ TWORD1 (SETQ TWORD2 TWORD]
          (SETQ NCTWORD (NCHARS TWORD1))
          (SETQ NCXWORD (COND
	      (ALTFLG              (* for purposes of call to skor, pretend that both words are same length so first
				   character matched against first character.)
		      NCTWORD)
	      (T NCXWORD0)))
          [COND
	    ((COND
		((IGREATERP NCTWORD NCXWORD)

          (* Checks to see if test word and unknown word differ sufficiently in number of characters so as to make it 
	  unnecessary to even call SKOR. This case is where test word is longer than XWORD. If number of characters in XWORD, 
	  NCW, divided by number of characters in test word, NCT, is less than REL than don't bother to call SKOR.
	  0 P)


		  (AND (NULL ALTFLG)
		       (ILESSP (IQUOTIENT (ITIMES NCXWORD 100)
					  NCTWORD)
			       REL)))
		((AND (NULL TAIL)
		      (ILESSP [IQUOTIENT (ITIMES NCTWORD 100)
					 (COND
					   ((EQ NCXWORD NDBLS)
					     1)
					   (T (IDIFFERENCE NCXWORD NDBLS]
			      REL))
                                   (* XWORD longer than test word. However, must allow for possibility of doubled 
				   characters.)
		  T))
	      (GO LP))
	    ([AND (SETQ SC (SKOR XWORD (SETQ TEM (DCHCON TWORD1 SKORLST2))
				 NCXWORD NCTWORD FROMDWIM))
		  (OR (NULL FN)
		      (COND
			((EQ FN (QUOTE GETD))
			  (FGETD TWORD2))
			(T (APPLY* FN TWORD2]
	      (SETQ TEM (COND
		  ((LISTP TWORD)   (* to distinguish from a runon correction, which is returned as a dotted pair.)
		    (LIST TWORD1 TWORD2))
		  ((AND GENFN (STRINGP TWORD))
		    (MKATOM TWORD))
		  (T TWORD)))      (* note that i dont know what happens if you have both a synonym and 
				   runoncorrecton)
	      (COND
		((LISTP SC)
		  [AND RUNONFLG TAIL [OR (NULL VAL)
					 (EQ TIEFLG (QUOTE EVERYTHING))
					 (IGREATERP NCTWORD (NCHARS (CAAR VAL]
		       (SETQ VAL (CONS (CONS TEM (PACKC SC))
				       (COND
					 ((EQ TIEFLG (QUOTE EVERYTHING))
					   VAL]

          (* TWORD1 used instead of TWORD2 becauseif any interaction, want user to approve in terms of his typeing, not the 
	  synonym. this will mean another call to spelling corrector to get the synonym, but big deal.)


		  )
		[(ZEROP SC)
		  (COND
		    ((EQ TIEFLG (QUOTE EVERYTHING))
		      (SETQ VAL (CONS TEM VAL)))
		    ((AND (NEQ TIEFLG (QUOTE ALL))
			  (NEQ TIEFLG (QUOTE LIST)))
                                   (* return the value)
		      (SETQ VAL TEM)
		      (GO OUT1))
		    ((NEQ REL 100)
                                   (* tieflg=LIST means list the tied candidates.
				   it used to be called ALL)
		      (SETQ REL 100)
		      (SETQ VAL (LIST TEM)))
		    (T (SETQ VAL (CONS TEM VAL]
		[(IGREATERP [SETQ SC (COND
				(ALTFLG (CHOOZ1 (SUB1 (IDIFFERENCE NCXWORD0 (IDIFFERENCE NCTWORD 
											 NCXWORD)))
						(SUB1 NCXWORD0)
						SC))
				(T (CHOOZ1 NCXWORD NCTWORD SC]
			    REL)
		  (SETQ VAL (CONS TEM (COND
				    ((EQ TIEFLG (QUOTE EVERYTHING))
				      VAL)
				    (T (SETQ REL SC)
                                   (* Now only look for words CLOSER than SC.)
				       NIL]
		((EQ SC REL)
		  (SETQ VAL (CONS TEM VAL]
          (GO LP)
      OUT [SETQ VAL (COND
	      ((OR (EQ TIEFLG (QUOTE ALL))
		   (EQ TIEFLG (QUOTE LIST))
		   (EQ TIEFLG (QUOTE EVERYTHING)))
		(COND
		  ((CDR VAL)
		    (DREVERSE VAL))
		  (T VAL)))
	      ((AND (CDR VAL)
		    (NULL TIEFLG))
                                   (* More than one.)
		NIL)
	      (T (CAR VAL]
      OUT1(RETURN VAL])

(CHOOZ1
  [LAMBDA (NC1 NC2 SC)                                      (* wt: 29-NOV-76 14 53)
    (PROG (TEM)

          (* The arithmetic expression computes the relative closeness as a percentage (times 100) by dividing the difference 
												     |
	  between the average number of characters and the number of mistakes, over the average number of characters.
												     |
	  This is (((a+b) /2) -
												     |
	  sc) / (a+b) /2 Multiplying top and bottom by two gives (A+B-2*SC/A+B))


          (RETURN (IQUOTIENT (ITIMES 100 (IDIFFERENCE (SETQ TEM (IPLUS NC1 NC2))
						      (ITIMES SC 2)))
			     TEM])

(SKOR0
  [LAMBDA (TWORD NCXWORD NDBLS LST)
                                   (* DD: "17-Dec-81 14:15")

          (* A special call to SKOR for use by editor. LST is an exploded chconlst of characteers, NCXWORD the number of 
	  characters in L, NDBLS the number of doubled characters. SKOR0 compares TWORD with L, and returns T if 'close'.)


    (PROG ((NCTWORD (NCHARS TWORD))
	   SC TEM TAIL ALTFLG)
          (RETURN (AND (COND
			 ((IGREATERP NCTWORD NCXWORD)
			   (NOT (ILESSP (IQUOTIENT (ITIMES NCXWORD 100)
						   NCTWORD)
					70)))
			 (T (IGREATERP [IQUOTIENT (ITIMES NCTWORD 100)
						  (COND
						    ((EQ NCXWORD NDBLS)
						      1)
						    (T (IDIFFERENCE NCXWORD NDBLS]
				       70)))
		       (NUMBERP (SETQ SC (SKOR LST (DCHCON TWORD SKORLST2)
					       NCXWORD NCTWORD)))
		       (OR (ZEROP SC)
			   (IGREATERP (IQUOTIENT (ITIMES (IDIFFERENCE (SETQ TEM (COND
									  ((IGREATERP NCXWORD NCTWORD)
									    NCXWORD)
									  (T NCTWORD)))
								      SC)
							 100)
						 TEM)
				      70])

(SKOR
  [LAMBDA (XWORD TWORD NCX NCT FROMDWIM)                    (* wt: " 8-APR-80 10:56")

          (* This algorithm counts the number of mistakes in the testword vis a vis the known word. A mistake is a character 
	  in the known word that does not have a corresponding character in the test word, or vice versa.
	  Mistakes are not counted until the end of the scoring, so that transpositions are not counted as mistakes.
	  Instead, whenever an unexplained character is encountered, the tail is put in a buffer for the corresponding word.
	  (For reasons of efficiency, instead of a genuine buffer, two PROG variables are used for each word: T1, T2, X1, and 
	  X2. Whenever these 'buffers' are exceeded, the skoring is aborted and NIL is returned as the value of SKOR.) When a 
	  character is found that does not match, it is first compared with the buffer for the other word.
	  If it is there, it is not counted as a mistake but as out of order. Out of order characters are counted as mistakes 
	  if they are misplaced by more than two positions, or if there are any other mistakes, e.g. substitutions or missing 
	  letters. Also, double letters are not counted as mistakes, nor are shift mistakes, e.g. @RINT vs PRINT gives a value
	  of 0)


    (PROG (X1 X2 T1 T2 X-1 XC TC (N 0)
	      (NTRANS 0)
	      TEM)
      LP  (SETQ XC (CAR XWORD))
          (SETQ TC (CAR TWORD))
          (COND
	    [(NULL XWORD)
	      (COND
		((NULL TWORD)
		  (GO OUT))
		(T (GO LP2]
	    ((EQ XC 27)                                     (* altmode)|
	      (COND|
		((SETQ XWORD (CDR XWORD))|
		  (RETURN)))|
	      (SETQ TWORD NIL)|
	      (GO LP1))|
	    ((NULL TWORD)
	      (GO LP1))
	    ((OR (EQ XC TC)
		 (AND (OR (EQ XC (IPLUS TC 16))
			  (EQ XC (IDIFFERENCE TC 16)))
		      (SELECTQ TC
			       [(33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 64 75 76 77 78 79)

          (* (! %" # $ %% & ' %( %) * + , -
	  %. / @ K L M N O) to their respective shift characters The last six transformations only operate on model 33's.)


				 (AND (EQ XC (IPLUS TC 16))
				      (OR MODEL33FLG (ILESSP TC 50]
			       [(49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 80 91 92 93 94 95)

          (* (1 2 3 4 5 6 7 8 9 : ; < = > ? P %[ \ %] ↑ ←) to their respective shift characters)


				 (AND (EQ XC (IDIFFERENCE TC 16))
				      (OR MODEL33FLG (ILESSP TC 65]
			       NIL))
		 [AND (NULL MODEL33FLG)
		      (OR (AND (EQ XC 48)
			       (EQ TC 95))
			  (AND (EQ XC 95)
			       (EQ XC 48]
		 (AND (EQ XC (IPLUS TC 32))
		      (IGREATERP XC 96))
		 (AND (EQ TC (IPLUS XC 32))
		      (IGREATERP TC 96))
		 (AND (EQ TC 49)
		      (EQ XC 76)))

          (* The 48-95 check is for 0 to ← The 32 check is for upper-lower case substitutions. The 49-76 check is typing L 
												     |
	  instead of 1, i.e. misreading the LISP manual.)


	      (SETQ XWORD (CDR XWORD))
	      (SUB1VAR NCX)
	      (SETQ TWORD (CDR TWORD))
	      (SUB1VAR NCT)
	      (SETQ X-1 XC)
	      (GO LP)))
      LP1 (COND
	    ([AND T2 (OR (EQ XC (SETQ TEM (CAR T2)))
			 (AND (EQ XC (IPLUS TEM 32))
			      (IGREATERP XC 96))
			 (AND (EQ TEM (IPLUS XC 32))
			      (IGREATERP TEM 96]

          (* Character encountered in TWORD before XWORD, e.g. the P in IPRNT vs PRINT. The case of RPINT vs PRINT is handled 
	  specially without ever going to the buffers.)


	      (COND
		((IGREATERP (FLENGTH T2)
			    (IPLUS NCX 2))
		  (ADD1VAR N))
		(T (ADD1VAR NTRANS)))
	      (SETQ T2 NIL)
	      (SETQ XWORD (CDR XWORD))
	      (SUB1VAR NCX)
	      (SETQ X-1 XC)
	      (GO LP))
	    ([AND T1 (OR (EQ XC (SETQ TEM (CAR T1)))
			 (AND (EQ XC (IPLUS TEM 32))
			      (IGREATERP XC 96))
			 (AND (EQ TEM (IPLUS XC 32))
			      (IGREATERP TEM 96]
	      (COND
		((IGREATERP (FLENGTH T1)
			    (IPLUS NCX 2))
		  (ADD1VAR N))
		(T (ADD1VAR NTRANS)))
	      (COND
		(T2 (SETQ T1 T2)
		    (SETQ T2 NIL))
		(T (SETQ T1 NIL)))
	      (SETQ XWORD (CDR XWORD))
	      (SUB1VAR NCX)
	      (SETQ X-1 XC)
	      (GO LP))
	    ((NULL TWORD)
	      (GO LP3)))
      LP2 (COND
	    ([AND X2 (OR (EQ TC (SETQ TEM (CAR X2)))
			 (AND (EQ TC (IPLUS TEM 32))
			      (IGREATERP TC 96))
			 (AND (EQ TEM (IPLUS TC 32))
			      (IGREATERP TEM 96]
	      (COND
		((IGREATERP (FLENGTH X2)
			    (IPLUS NCT 2))
		  (ADD1VAR N))
		(T (ADD1VAR NTRANS)))                       (* Character encountered in XWORD first, e.g. I in IPRNT
												     |
							    vs PRINT.)
	      (SETQ X2 NIL)
	      (SETQ TWORD (CDR TWORD))
	      (SUB1VAR NCT)
	      (GO LP))
	    ([AND X1 (OR (EQ TC (SETQ TEM (CAR X1)))
			 (AND (EQ TC (IPLUS TEM 32))
			      (IGREATERP TC 96))
			 (AND (EQ TEM (IPLUS TC 32))
			      (IGREATERP TEM 96]
	      (COND
		((IGREATERP (FLENGTH X1)
			    (IPLUS NCT 2))
		  (ADD1VAR N))
		(T (ADD1VAR NTRANS)))
	      (COND
		(X2 (SETQ X1 X2)
		    (SETQ X2 NIL))
		(T (SETQ X1 NIL)))
	      (SETQ TWORD (CDR TWORD))
	      (SUB1VAR NCT)
	      (GO LP))
	    ((AND XWORD (EQ XC (CADR TWORD))
		  (EQ TC (CADR XWORD))
		  (NEQ TC (CADDR TWORD)))

          (* Special check for most common case of transposition. The last clause is an attempt to distinguish the case of a 
												     |
	  transposition from simply getting out of synch. e.g. consider MYCIN vs MICIN. The Y is discarded, and then we are 
												     |
	  comparing CIN with ICIN. Treating CI as a transposition of IC is wrong in this case, since it matches with CI if the
												     |
	  I is discarded.)


	      (SETQ X-1 (CADR XWORD))
	      (SETQ XWORD (CDDR XWORD))
	      (SUB1VAR NCX)
	      (SUB1VAR NCX)
	      (ADD1VAR NTRANS)
	      (SETQ TWORD (CDDR TWORD))
	      (SUB1VAR NCT)
	      (SUB1VAR NCT)
	      (GO LP))
	    ((IGREATERP NCT NCX)                            (* Remove from TWORD.)
	      (COND
		((NULL T1)
		  (SETQ T1 TWORD))
		((NULL T2)
		  (SETQ T2 TWORD))
		([AND ALTFLG (OR (EQ XC X-1)
				 (EQ XC (CADR XWORD]

          (* we already have two unaccounted for characters in tword, the (still) longer word. no point in checking for 
												     |
	  doubled character in xword, because even if it were, still would be three characters unaccounted for.
												     |
	  however, if altflg is T, then worthwhile. reason why we dont do this before goig through T1 and T2 is that it might 
												     |
	  NOT be a doubled character, but a missplaced character.)


		  (GO LP3))
		(T (RETURN NIL)))
	      (SETQ TWORD (CDR TWORD))
	      (SUB1VAR NCT)
	      (GO LP)))
      LP3 (COND
	    ((OR (EQ XC X-1)
		 (EQ XC (CADR XWORD)))

          (* About to remove from XWORD, check for double char. first check says was equal to last character.
												     |
	  This occurs when last character was correct. Second check says equal to next character, so throw this one away.)


	      (SETQ XWORD (CDR XWORD))
	      (SETQ NCXWORD (SUB1 NCXWORD))

          (* Bound in CHOOZ. When computing value of SKOR, want to divide number of mistakes by actual length of word, i.e. 
												     |
	  length minus number of doubled characters. Otherwise, making a word longer by adding extra characters will make it 
												     |
	  CLOSER, e.g. ZZZZZZZ would correct to PP.)


	      (SUB1VAR NCX))
	    [[AND TAIL (NULL TWORD)
		  (NULL T1)
		  (NULL T2)
		  (NULL X1)
		  (NULL X2)
		  (ZEROP N)
		  (OR (ILESSP (ITIMES NTRANS 4)
			      NCTWORD)
		      (NULL (CDR XWORD]

          (* The ilessp check is to discourage runon corrections when there is also a transposition unless the word is long, 
												     |
	  e.g. PRETTYRPINTX will correct, but CNOSX wont.)


	      (RETURN (COND
			((AND FROMDWIM CLISPFLG (FMEMB (FCHARACTER (CAR XWORD))
						       CLISPCHARS))

          (* so that it does not consider runoncorrection splitting it at a clisp operator. E.g. if X*Y appears in your 
												     |
	  functio and X is the name of a variable but Y is not, when dwim goes on to look for another corrrection because Y is
												     |
	  not bound, it shuld not offer X *Y as a possibility as this is almost always wrong.)


			  NIL)
			([AND FROMDWIM CLISPFLG (OR (CDR XWORD)
						    (CDR TAIL))
			      (EQ (CAR XWORD)
				  (COND
				    (MODEL33FLG 79]         (* mistyped O for ← on 33 or 0 for ← on 33)
			  (CONS 95 (CDR XWORD)))
			(T XWORD]
	    (T (COND
		 ((NULL X1)
		   (SETQ X1 XWORD))
		 ((NULL X2)
		   (SETQ X2 XWORD))
		 (T (RETURN NIL)))
	       (SETQ XWORD (CDR XWORD))
	       (SUB1VAR NCX)
	       (SETQ X-1 XC)))
          (GO LP)
      OUT [COND
	    ((AND (NULL XWORD)
		  (NULL TWORD)
		  T1 X1)
	      (SETQ T1 (FLENGTH T1))
	      (SETQ X1 (FLENGTH X1))
	      (AND T2 (SETQ T2 (FLENGTH T2)))
	      (AND X2 (SETQ X2 (FLENGTH X2)))
	      (COND
		((OR (EQ T1 X1)
		     (EQ T1 X2))                            (* Check for substitution errors.
												     |
							    Subtracts one so when two gets added below, net effect 
												     |
							    is only counted as one.)
		  (SUB1VAR N)))
	      (COND
		((AND T2 (OR (EQ T2 X1)
			     (EQ T2 X2)))
		  (SUB1VAR N]
          [SETQ N (IPLUS N (COND
			   (X2 2)
			   (X1 1)
			   (T 0))
			 (COND
			   (T2 2)
			   (T1 1)
			   (T 0]
          (RETURN (COND
		    ((AND (NULL ALTFLG)
			  (OR (EQ N 0)
			      FASTYPEFLG))

          (* If FASTYPEFLG is T, transpositions are not counted as errors. Otherwise, transpositions are counted if there are 
	  other errors, i.e. if thee are no errors except for transpostions, SKOR returns 0.0)


		      N)
		    (T (IPLUS N NTRANS])

(MOVETOP
  [LAMBDA (X L)                                             (* Used by spelling block and 
							    helpfixblock.)
    (PROG ((Y L)
	   Z)
      LP  (COND
	    ((NULL Y)
	      (RETURN L))
	    ((NEQ (CAR Y)
		  X)
	      (SETQ Z Y)
	      (SETQ Y (CDR Y))
	      (GO LP))
	    ((NEQ Y L)
	                                                    (* Move to front of list)
	      (FRPLACD Z (CDR Y))
	      (FRPLACD Y (CDR L))
	      (FRPLACD L Y)
	      (FRPLACA Y (CAR L))
	      (FRPLACA L X)))
          (RETURN L])
)

(RPAQ? USERWORDS )

(RPAQ? SPELLINGS1 (QUOTE (DEFINEQ ARGLIST MOVD GETD FNTYP BREAK UNBREAK REBREAK TRACE BREAKIN 
				  MAKEFILE MAKEFILES LISTFILES FILES? WHEREIS CLEANUP PP PF EDITF 
				  EDITV EDITP ADVISE UNADVISE UNSAVEDEF RECOMPILE TCOMPL COMPILE 
				  BRECOMPILE BCOMPL MAPCAR MAPC LOAD LOADFROM LOADFNS TIME CLOSEF 
				  CLOSEALL OPENP OUTPUT INPUT OUTFILE INFILE LOGOUT PUTPROP REMPROP 
				  GETPROP SYSOUT CLISPIFY DWIMIFY EDITCALLERS FREEVARS CALLS)))

(RPAQ? SPELLINGS2 (QUOTE (GETPROP ADD1 AND APPEND ASSOC ATOM COND CONS COPY ELT EQ EQUAL ERROR ERSETQ 
				  EVAL FASSOC FMEMB FRPLACA FRPLACD FUNCTION GO IDIFFERENCE IGREATERP 
				  ILESSP IMINUS IPLUS ITIMES LENGTH LIST LISTP MAPC MAPCAR MAPCONC 
				  MEMB MEMBER NCONC NCONC1 NEQ NLISTP NLSETQ NULL NUMBERP OR PRINT 
				  PRIN1 PROG PROGN PUTPROP QUOTE READ RETURN RPLACA RPLACD SELECTQ 
				  SETA SETQ SPACES SUB1 TERPRI ZEROP IF F/L VALUEOF FOR FETCH REPLACE 
				  CREATE GETPROP PUTPROP DIFFERENCE GREATERP LESSP PLUS)))

(RPAQ? SPELLINGS3 (QUOTE (BROKENFNS ADVISEDFNS NOTLISTEDFILES FILELST NOTCOMPILEDFILES PROMPT#FLG 
				    CLISPIFYPRETTYFLG DWIMIFYCOMPFLG FILERDTBL EDITRDTBL SYSPRETTYFLG 
				    NOSPELLFLG INITIALS NIL)))

(RPAQ? SPELLSTR1 "{spellseparator}")

(RPAQ? SPELLSTR2 "{spellignore}")

(RPAQ? FIXSPELLREL 70)

(RPAQ? FIXSPELLDEFAULT (QUOTE y))

(RPAQ? SKORLST1 (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL 
			    NIL)))

(RPAQ? SKORLST2 (QUOTE (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL 
			    NIL)))

(RPAQ? DWIMKEYLST NIL)

(RPAQ? FIXSPELLKEYLST NIL)

(RPAQ? FASTYPEFLG )

(RPAQ? RUNONFLG T)

(RPAQ? #USERWORDS 60)

(RPAQ? #SPELLINGS1 60)

(RPAQ? #SPELLINGS2 60)

(RPAQ? #SPELLINGS3 60)

(RPAQ? DWIMWAIT 10)

(RPAQ? RESPELLS )

(RPAQ? MODEL33FLG )
(NCONC1 SPELLINGS1 SPELLSTR1)
(NCONC1 SPELLINGS2 SPELLSTR1)
(ATTACH SPELLSTR1 SPELLINGS3)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: FIXSPELLBLOCK MISSPELLED? FIXSPELL CHOOZ CHOOZ1 SKOR SKOR0 MOVETOP
	(ENTRIES MISSPELLED? FIXSPELL CHOOZ SKOR0 SKOR MOVETOP)
	(LOCALFREEVARS NCXWORD NCTWORD TAIL ALTFLG)
	(GLOBALVARS CLISPCHARS CLISPFLG DWIMFLG EDITQUIETFLG FASTYPEFLG FCHARAR LASTWORD MODEL33FLG 
		    NOSPELLFLG RUNONFLG SKORLST1 SKORLST2 SPELLINGS1 SPELLINGS2 SPELLSTATS1 SPELLSTR1 
		    SPELLSTR2))
(BLOCK: FIXSPELL1 FIXSPELL1 FIXSPELL2 (GLOBALVARS APPROVEFLG COMMENTFLG CUTEFLG DWIMKEYLST DWIMWAIT 
						  REREADFLG RESPELLS RUNONSTATS SPELLSTATS 
						  SPELLSTATS1 VETOSTATS))
(BLOCK: ADDSPELLBLOCK ADDSPELL ADDSPELL1 (ENTRIES ADDSPELL ADDSPELL1)
	(GLOBALVARS #SPELLINGS2 #SPELLINGS3 #USERWORDS LASTWORD SPELLINGS1 SPELLINGS2 SPELLINGS3 
		    SPELLSTR1 SPELLSTR2 USERWORDS))
(BLOCK: NIL ADDSPELL2 (GLOBALVARS SPELLSTR2))
]
(PUTPROPS SPELL COPYRIGHT (NONE))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3120 43691 (ADDSPELL 3130 . 5406) (ADDSPELL1 5408 . 9353) (ADDSPELL2 9355 . 9551) (
MISSPELLED? 9553 . 10308) (FIXSPELL 10310 . 19448) (FIXSPELL1 19450 . 25746) (FIXSPELL2 25748 . 26229)
 (CHOOZ 26231 . 31710) (CHOOZ1 31712 . 32361) (SKOR0 32363 . 33422) (SKOR 33424 . 43148) (MOVETOP 
43150 . 43689)))))
STOP