diff --git a/lispusers/ANALYZER.LCOM b/lispusers/ANALYZER.LCOM deleted file mode 100644 index 5c082e2bb..000000000 Binary files a/lispusers/ANALYZER.LCOM and /dev/null differ diff --git a/lispusers/DICTTOOL b/lispusers/DICTTOOL deleted file mode 100644 index e1cd0b746..000000000 --- a/lispusers/DICTTOOL +++ /dev/null @@ -1,1780 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED " 1-Feb-2022 16:42:35" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>DICTTOOL.;2 92394 - - :CHANGES-TO (VARS DICTTOOLCOMS) - - :PREVIOUS-DATE " 1-Mar-94 10:43:44" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>DICTTOOL.;1) - - -(* ; " -Copyright (c) 1986-1989, 1991, 1994 by Xerox Corporation. -") - -(PRETTYCOMPRINT DICTTOOLCOMS) - -(RPAQQ DICTTOOLCOMS - ((COMS * DICTTOOLDEPENDENCIES) - (FILES ANALYZER) - - (* ;; "RMK 2022: DICTCLIENT has disappeared") - - (* (FILES (FROM {NFS}DICTSERVER>LISP>) - DICTCLIENT)) - - (* ;; "1/6/89 jtm: fixed TEdit.PrintDefinition so that SimpleDicts would print their entries in the definition window.") - - - (* ;; "1/6/89 jtm: changed TEdit.SetDictionary and DictForStream so that TEdit.DefaultDictionary reflects the default dictionary to use if no other is specified.") - - - (* ;; "2/28/89 jtm: changed FILES so that DICTCLIENT is loaded from PIGLET.") - - - (* ;; - "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.") - - - (* ;; "3/27/91 jtm: added TEdit interface to the SearchMenu module") - - - (* ;; "3/1/94 jtm: changed the loading of DICTCLIENT and SEARCHMENU") - - (FNS TEDIT.INCLUDESTREAM TEdit.PrintDefinition DictTool.PrintDefinition Dict.PrintDefinition - DictTool.GetEntry TEdit.SetDictionary DictForStream DictTool.Dictionaries PARSEBYCOLONS - PrintPronunciationGuide ConvertPronunciation) - (FNS TEdit.SearchMenu TEdit.PrintSearch DictTool.PrintSearch DictTool.MergeSearch - NerdForStream TEdit.SetNerd DictTool.PromptForCutoff DictTool.PromptForKeywordCutoff - PARSESELECTION) - (FNS TEdit.PrintPhraseSearch DictTool.PrintPhraseSearch) - (FNS TEdit.PrintSynonyms REMOVEALL CONVERTFUNCTIONSTOFORMS TEdit.PrintNounSynonyms - DictTool.PrintNounSynonyms DictTool.PrintVerbSynonyms DictTool.PrintAdjSynonyms - TEdit.PrintVerbSynonyms TEdit.PrintAdjSynonyms DictTool.PrintSynonyms) - (FNS DictTool.TEditWrapper Dict.OutputStream DictTool.PromptStream) - (FNS DictTool.Init DictTool.Open DictTool.OpenDictionary DictTool.OpenAnalyzer - DictTool.OpenNerd Dict.AddCommands DictTool.Close) - (FNS DictTool.Analyze DictTool.Analyzers DictTool.Pronunciation DictTool.Corrections - DictTool.CountWords) - (COMS (* * FINDWORD & SUBSTITUTEWORD) - (FNS DictTool.FindWord DictTool.SubstituteWord DictTool.CreateConjugationMap - DictTool.FindWordInit) - (FNS LingFns.FindWord LingFns.Capitalize LingFns.Capitalization) - (P (DictTool.FindWordInit))) - (INITVARS DictTool.TimeOperation Dict.DefWindow Dict.CommandsAdded InvertedDict.List - DictTool.LastSearch DictTool.LastWord TEdit.DefaultDictionary (DictTool.MinKeywords - 2) - (DictTool.MaxWords 100)) - (GLOBALVARS DictTool.TimeOperation Dict.DefWindow Dict.CommandsAdded InvertedDict.List - DictTool.MinKeywords DictTool.MaxWords DictTool.LastSearch DictTool.LastWord - TEdit.DefaultDictionary) - (P (DictTool.Init)) - (VARS PronunciationGuide PronunciationMap))) - -(RPAQQ DICTTOOLDEPENDENCIES - [(* * code to make sure that the right versions of everything are loaded. The P must be - executed before any FILES commands.) - [E (PUTPROP 'DICTTOOL 'DEPENDENCIES (for FILE in (FILECOMSLST 'DICTTOOL 'FILES) - collect - (CONS FILE (CAAR (GETPROP FILE 'FILEDATES] - (PROP DEPENDENCIES DICTTOOL) - (P (for FILE FILEDATE in (GETPROP 'DICTTOOL 'DEPENDENCIES) - do - [SETQ FILEDATE (CAAR (GETPROP (CAR FILE) - 'FILEDATES] - (COND ([AND FILEDATE (CDR FILE) - (ILESSP (IDATE FILEDATE) - (IDATE (CDR FILE] - (* clear FILEDATES to force FILESLOAD to reload the file.) - (printout T "Flushing old version of " (CAR FILE) - T) - (PUTPROP (CAR FILE) - 'FILEDATES NIL]) - (* * code to make sure that the right versions of everything are loaded. The P must be executed before - any FILES commands.) - - -(PUTPROPS DICTTOOL DEPENDENCIES ((ANALYZER . " 9-Mar-89 15:24:58"))) - -[for FILE FILEDATE in (GETPROP 'DICTTOOL 'DEPENDENCIES) - do [SETQ FILEDATE (CAAR (GETPROP (CAR FILE) - 'FILEDATES] - (COND - ([AND FILEDATE (CDR FILE) - (ILESSP (IDATE FILEDATE) - (IDATE (CDR FILE] (* clear FILEDATES to force FILESLOAD - to reload the file.) - (printout T "Flushing old version of " (CAR FILE) - T) - (PUTPROP (CAR FILE) - 'FILEDATES NIL] - -(FILESLOAD ANALYZER) - - - -(* ;; "RMK 2022: DICTCLIENT has disappeared") - - - - -(* (FILES (FROM {NFS}DICTSERVER>LISP>) DICTCLIENT)) - - - - -(* ;; -"1/6/89 jtm: fixed TEdit.PrintDefinition so that SimpleDicts would print their entries in the definition window." -) - - - - -(* ;; -"1/6/89 jtm: changed TEdit.SetDictionary and DictForStream so that TEdit.DefaultDictionary reflects the default dictionary to use if no other is specified." -) - - - - -(* ;; "2/28/89 jtm: changed FILES so that DICTCLIENT is loaded from PIGLET.") - - - - -(* ;; "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.") - - - - -(* ;; "3/27/91 jtm: added TEdit interface to the SearchMenu module") - - - - -(* ;; "3/1/94 jtm: changed the loading of DICTCLIENT and SEARCHMENU") - -(DEFINEQ - -(TEDIT.INCLUDESTREAM - [LAMBDA (TEXTSTREAM INCLUDEDSTREAM) (* jtm%: "28-Oct-87 14:41") - (LET (STARTPOS) - (SETQ STARTPOS (ADD1 (GETEOFPTR TEXTSTREAM))) - (TEDIT.COPY (TEDIT.SETSEL INCLUDEDSTREAM 1 (GETEOFPTR INCLUDEDSTREAM) - 'LEFT) - (TEDIT.SETSEL TEXTSTREAM STARTPOS 0 'LEFT)) - (TEDIT.SETSEL TEXTSTREAM STARTPOS 0 'LEFT) - (TEDIT.NORMALIZECARET TEXTSTREAM) - (TEDIT.STREAMCHANGEDP TEXTSTREAM T]) - -(TEdit.PrintDefinition - [LAMBDA (stream dict words) (* ; "Edited 6-Jan-89 11:46 by jtm:") - - (* * prints out the definition of the currently selected text.) - - (OR stream (SETQ stream (Dict.OutputStream))) - (DictTool.TEditWrapper (OR dict (DictForStream stream)) - [FUNCTION (LAMBDA (dict selection stream) - (LET (printFn entry) - (for word exists in (PARSEBYCOLONS selection) - do [COND - ((AND (SETQ printFn (fetch (Dict printEntryFn) - of dict)) - (NEQ printFn 'NILL)) - (SETQ exists (OR (APPLY* printFn dict word stream) - exists))) - ((SETQ printFn (fetch (Dict getEntryFn) of dict)) - (SETQ entry (APPLY* printFn dict word NIL)) - [for def (left _ (LENGTH entry)) inside entry - first (TEDIT.INSERT stream (CONCAT word ": ")) - do [COND - ((STREAMP def) - (SETQ def (STREAM.FETCHSTRING def 0 - (GETEOFPTR def] - (TEDIT.INSERT stream def) - (add left -1) - (COND - ((IGEQ left 1) - (TEDIT.INSERT stream ", ")) - (T (TEDIT.INSERT stream " - -"] - (SETQ exists (OR entry exists] finally (RETURN exists] - stream words "word to look up:" "Getting definition for"]) - -(DictTool.PrintDefinition - [LAMBDA (dict words stream) (* jtm%: "17-Nov-87 11:02") - (PROG (def looks found pos (offset 0)) - [for word inside (PARSEBYCOLONS words) - do (SETQ def (Dict.GetEntry dict word)) - (SETQ looks (Dict.Prop dict 'Looks)) - (COND - ((AND (NULL looks) - (Dict.Prop dict 'RemoteDict)) - [SETQ looks (DICTCLIENT.GETLOOKS (Dict.Prop dict 'RemoteDict] - (Dict.Prop dict 'Looks looks))) - (COND - [(STRINGP def) - (SETQ found T) - (TEDIT.INSERT stream def) - (for I from 1 to 2 when (NEQ 13 (NTHCHARCODE def (IMINUS I))) - do (TEDIT.INSERT stream (CHARACTER 13] - ([AND (STRINGP (CAR def)) - (NOT (STREQUAL "" (CAR def] - (SETQ found T) - (TEDIT.INSERT stream (CAR def) - NIL - (CDAR looks)) - (for I from 1 to 2 when (NEQ 13 (NTHCHARCODE def (IMINUS I))) - do (TEDIT.INSERT stream (CHARACTER 13))) - (* assumes that the first look given - is the default for the dictionary.) - (SETQ pos (TEDIT.GETPOINT stream)) (* setting looks moves the selection) - (for i in (CDR def) do (TEDIT.LOOKS stream (CDR (FASSOC (CADDR i) - looks)) - (IPLUS (CAR i) - offset) - (CADR i))) - (SETQ offset (SUB1 pos)) - (TEDIT.SETSEL stream pos 0 'LEFT)) - (NIL (TEDIT.INSERT stream (CONCAT word ": not found.")) - (TEDIT.LOOKS stream '(FAMILY HELVETICA SIZE 10 FACE BOLD) - 1 - (ADD1 (NCHARS word))) - (TEDIT.LOOKS stream '(FAMILY TIMESROMAN SIZE 10 FACE STANDARD) - (IPLUS 2 (NCHARS word)) - 11] - (RETURN found]) - -(Dict.PrintDefinition - [LAMBDA (dict word stream) (* jtm%: "13-Oct-87 10:27") - (PROG (scratch start) - [COND - ((NULL stream) - (SETQ stream (Dict.OutputStream] - [SETQ scratch (OPENTEXTSTREAM NIL NIL NIL NIL '(LEAVETTY] - (COND - ((Dict.PrintEntry dict word scratch) - (TEDIT.INSERT scratch (CONCAT (CHARACTER 13) - (CHARACTER 13)) - (ADD1 (GETEOFPTR scratch))) - (SETQ start (ADD1 (GETEOFPTR stream))) - (TEDIT.COPY (TEDIT.SETSEL scratch 1 (GETEOFPTR scratch) - 'LEFT) - (TEDIT.SETSEL stream start 0 'LEFT)) - (CLOSEF scratch) - (TEDIT.SETSEL stream start 0 'RIGHT) - (TEDIT.NORMALIZECARET stream) - (TEDIT.STREAMCHANGEDP stream T) - (RETURN T]) - -(DictTool.GetEntry - [LAMBDA (dict uniqueID prop) (* jtm%: " 7-Apr-87 08:39") - (COND - [(NUMBERP uniqueID) - (DICTCLIENT.ENUMERATE uniqueID (Dict.Prop dict 'RemoteDict] - (T (DICTCLIENT.GETDEFINITION uniqueID (Dict.Prop dict 'RemoteDict]) - -(TEdit.SetDictionary - [LAMBDA (stream dict) (* ; "Edited 6-Jan-89 12:24 by jtm:") - - (* * sets the dictionary property for the window) - - (PROG (menuItems) - (OR stream (SETQ stream (Dict.OutputStream))) - [COND - ((NULL dict) - [SETQ menuItems (for i in Dict.DictionaryList - collect (LIST (Dict.Name i) - (LIST 'QUOTE i) - (if (Dict.Prop i 'RemoteDict) - then "Calls the remote dictionary server"] - [COND - ((NULL menuItems) - (TEDIT.PROMPTPRINT stream "Sorry, no dictionaries loaded." T)) - ((EQ 1 (LENGTH menuItems)) - (SETQ dict (CAR Dict.DictionaryList))) - (T (SETQ dict (MENU (create MENU - ITEMS _ menuItems - TITLE _ "dictionaries" - CENTERFLG _ T] - (COND - ((NULL dict) - (SETQ dict (STREAMPROP stream 'dict)) - (TEDIT.PROMPTPRINT stream (CONCAT "Dictionary is " (AND dict (Dict.Name dict)) - ".") - T) - (RETURN] - (TEDIT.PROMPTPRINT stream (CONCAT "Setting dictionary to " (AND dict (Dict.Name dict)) - "...") - T) - (Dict.Open dict) - (STREAMPROP stream 'dict dict) - - (* ;; "1/6/89 jtm: set TEdit.DefaultDictionary if this is the dictionary window or if it hasn't already been set.") - - (if [OR (NULL TEdit.DefaultDictionary) - (AND (WINDOWP Dict.DefWindow) - (EQ stream (WINDOWPROP Dict.DefWindow 'TEXTSTREAM] - then (SETQ TEdit.DefaultDictionary dict)) - (TEDIT.PROMPTPRINT stream "done.")) - dict]) - -(DictForStream - [LAMBDA (stream) (* ; "Edited 6-Jan-89 12:26 by jtm:") - - (* ;; "1/6/89 jtm: Try TEdit.DefaultDictionary if the stream doesn't have it's own dictionary.") - - (COND - ((STREAMPROP stream 'dict)) - (TEdit.DefaultDictionary) - (T (TEdit.SetDictionary (Dict.OutputStream]) - -(DictTool.Dictionaries - [LAMBDA (dict errorStream) (* jtm%: "13-Nov-86 10:57") - (DICTCLIENT.DICTIONARIES]) - -(PARSEBYCOLONS - [LAMBDA (STRING COLONSORSPACES) (* ; "Edited 11-Jan-89 13:55 by jtm:") - - (* * Actually, parse by SEMI-colons.) - - (LET (WORDS SEPARATOR (OLDPOS 1) - (POS 0)) - (COND - ((STRINGP STRING) - (SETQ SEPARATOR (COND - ([AND COLONSORSPACES (NULL (STRPOS ";" STRING (ADD1 POS] - " ") - (T ";"))) - [while (SETQ POS (STRPOS SEPARATOR STRING (ADD1 POS))) - do (push WORDS (SUBSTRING STRING OLDPOS (SUB1 POS))) - (SETQ OLDPOS (for I from (ADD1 POS) - thereis (NEQ 32 (NTHCHARCODE STRING I] - [COND - ((AND (NEQ OLDPOS 0) - (ILEQ OLDPOS (NCHARS STRING))) - (push WORDS (SUBSTRING STRING OLDPOS (NCHARS STRING] - (OR (DREVERSE WORDS) - STRING)) - (T STRING]) - -(PrintPronunciationGuide - [LAMBDA (stream) (* jtm%: " 9-Feb-87 08:40") - (LET (startPos) - (SETQ startPos (GETFILEPTR stream)) - [for i pronCode on PronunciationGuide do (SETQ pronCode (CAR i)) - (TEDIT.INSERT stream (CONCAT (ConvertPronunciation - (CAR pronCode)) - ": " - (CADR pronCode) - " " - (ConvertPronunciation - (CADDR pronCode)) - (COND - ((CDR i) - "; ") - (T ""] - (TEDIT.LOOKS stream '(FAMILY CLASSIC SIZE 10 FACE STANDARD) - (ADD1 startPos) - (IDIFFERENCE (GETFILEPTR stream) - startPos]) - -(ConvertPronunciation - [LAMBDA (string) (* jtm%: " 6-Feb-87 17:38") - (CONCATLIST (for i char nschars from 1 to (NCHARS string) join (SETQ char (NTHCHAR string i)) - (SETQ nschars - (CDR (FASSOC char - PronunciationMap))) - (COND - ((NULL nschars) - (LIST char)) - ((LISTP nschars) - (COPY nschars)) - (T (LIST nschars]) -) -(DEFINEQ - -(TEdit.SearchMenu - [LAMBDA (stream dict words) (* ; "Edited 1-Mar-94 10:28 by jtm:") - (LOAD? 'SEARCHMENU.MCOM) - (if (NOT (OPENWP SearchMenu)) - then (SearchMenu.Create]) - -(TEdit.PrintSearch - [LAMBDA (stream dict words) (* jtm%: "13-Oct-87 10:11") - - (* * prints out the definition of the currently selected text.) - - (OR stream (SETQ stream (Dict.OutputStream))) - (DictTool.TEditWrapper (OR dict (NerdForStream stream)) - 'DictTool.PrintSearch stream words "Type keywords to search on:" - "Searching for words using" 'SEARCHKEYS]) - -(DictTool.PrintSearch - [LAMBDA (dict selection stream) (* jtm%: " 7-Apr-87 09:52") - (LET (looks venn) - (SETQ venn (DictTool.MergeSearch dict selection)) - [for i pos in venn do (* printout header) - (SETQ pos (TEDIT.GETPOINT stream)) - [for header on (CAR i) do (TEDIT.INSERT stream (CONCAT - (CAR header) - (COND - ((CDR header) - " ") - (T ": "] - (push looks (CONS pos (IDIFFERENCE (TEDIT.GETPOINT stream) - pos))) - [for word on (CADR i) do (TEDIT.INSERT stream (CONCAT (CAR word) - (COND - ((CDR word) - "; ") - (T ""] - (TEDIT.INSERT stream (CHARACTER (CHARCODE CR))) - (TEDIT.INSERT stream (CHARACTER (CHARCODE CR] - (* do the looks last to avoid messing - up the text placement.) - (TEDIT.LOOKS stream '(FAMILY TIMESROMAN SIZE 10 FACE STANDARD) - 1 - (TEDIT.GETPOINT stream)) - (for look in looks do (TEDIT.LOOKS stream '(FAMILY HELVETICA SIZE 10 FACE BOLD) - (CAR look) - (CDR look))) - venn]) - -(DictTool.MergeSearch - [LAMBDA (dict synonymclasses minKeywords minWord maxWord) (* jtm%: " 2-Aug-88 13:15") - (LET (minWord maxWord VennSearchFn) - [for i on synonymclasses do (COND - ((NLISTP (CAR i)) - (RPLACA i (LIST (CAR i] - [COND - ((AND (NULL minWord) - (NULL maxWord)) - (COND - ((AND (EQUAL synonymclasses DictTool.LastSearch) - (NEQ 0 DictTool.MaxWords)) - (COND - ((NULL DictTool.LastWord) - (SETQ DictTool.LastWord 0))) - (SETQ minWord (ADD1 DictTool.LastWord)) - [SETQ maxWord (COND - ((EQ 0 DictTool.MaxWords) - 0) - (T (IPLUS DictTool.MaxWords DictTool.LastWord] - (SETQ DictTool.LastWord maxWord)) - (T (SETQ minWord 0) - (SETQ maxWord DictTool.MaxWords) - (SETQ DictTool.LastSearch synonymclasses) - (SETQ DictTool.LastWord maxWord] - (COND - [(InvertedDict.Prop dict 'RemoteDict) - (DICTCLIENT.SEARCHFORWORD synonymclasses DictTool.MinKeywords (OR minWord 0) - (OR maxWord DictTool.MaxWords) - (InvertedDict.Prop dict 'RemoteDict] - ((SETQ VennSearchFn (InvertedDict.Prop dict 'VENNSEARCHFN)) - (APPLY* VennSearchFn dict synonymclasses DictTool.MinKeywords (OR minWord 0) - (OR maxWord DictTool.MaxWords))) - (T (InvertedDict.MergeSearch dict synonymclasses DictTool.MinKeywords (OR minWord 0) - (OR maxWord DictTool.MaxWords]) - -(NerdForStream - [LAMBDA (stream) (* jtm%: "17-Nov-87 11:14") - - (* * comment) - - (COND - ((STREAMPROP stream 'nerd)) - ((STREAMPROP (Dict.OutputStream) - 'nerd)) - (T (TEdit.SetNerd (Dict.OutputStream]) - -(TEdit.SetNerd - [LAMBDA (stream nerd) (* jtm%: "14-Oct-87 12:50") - - (* * sets the dictionary property for the window) - - (PROG (menuItems) - (OR stream (SETQ stream (Dict.OutputStream))) - [COND - ((NULL nerd) - [SETQ menuItems (for i in InvertedDict.List - collect (LIST (InvertedDict.Name i) - (LIST 'QUOTE i) - (if (InvertedDict.Prop i 'RemoteDict) - then "Calls the remote dictionary server"] - [COND - ((NULL menuItems)) - ((EQ 1 (LENGTH menuItems)) - (SETQ nerd (CAR InvertedDict.List))) - (T (SETQ nerd (MENU (create MENU - ITEMS _ menuItems - TITLE _ "databases" - CENTERFLG _ T] - (COND - ((NULL nerd) - (SETQ nerd (STREAMPROP stream 'nerd)) - (TEDIT.PROMPTPRINT stream (CONCAT "Database is " (AND nerd (InvertedDict.Name - nerd)) - ".") - T) - (RETURN] - (TEDIT.PROMPTPRINT stream (CONCAT "Setting database to " (AND nerd (InvertedDict.Name - nerd)) - "...") - T) - (InvertedDict.Open nerd) - (STREAMPROP stream 'nerd nerd) - (TEDIT.PROMPTPRINT stream "done.") - (SETQ DictTool.LastSearch NIL) (* so that you can do the same search - on a different data base.) - ) - nerd]) - -(DictTool.PromptForCutoff - [LAMBDA (STREAM) (* jtm%: " 2-Feb-87 11:33") - (OR STREAM (SETQ STREAM (Dict.OutputStream))) - (TEDIT.PROMPTPRINT STREAM (CONCAT "Current maximum = " DictTool.MaxWords ".") - T) - (SETQ DictTool.MaxWords (RNUMBER - "Enter the maximum number of words that each combination of keywords may return. (0 = no limit)" - )) - (TEDIT.PROMPTPRINT STREAM (CONCAT "New maximum = " DictTool.MaxWords ".") - T]) - -(DictTool.PromptForKeywordCutoff - [LAMBDA (STREAM) (* jtm%: " 2-Feb-87 11:33") - (OR STREAM (SETQ STREAM (Dict.OutputStream))) - (TEDIT.PROMPTPRINT STREAM (CONCAT "Current minimum = " DictTool.MinKeywords ".") - T) - (SETQ DictTool.MinKeywords (RNUMBER "Enter the minimum number of keywords that a word must have to be accepted. e.g. 2 = at least two keywords, 0 = all of the keywords given, -2 = all but two of the keywords given, etc." - )) - (TEDIT.PROMPTPRINT STREAM (CONCAT "New minimum = " DictTool.MinKeywords ".") - T]) - -(PARSESELECTION - [LAMBDA (selection) (* jtm%: "20-Mar-87 14:39") - (LET (words temp) - [for i charcode startPos alpha priorAlpha word from 1 to (ADD1 (NCHARS selection)) - do (SETQ charcode (NTHCHARCODE selection i)) - (SETQ priorAlpha alpha) - [SETQ alpha (AND charcode (OR (ALPHACHARP charcode) - (EQ charcode (CHARCODE -] - [COND - ((AND alpha (NULL priorAlpha)) - (SETQ startPos i)) - ((AND priorAlpha (NULL alpha)) - (SETQ word (SUBSTRING selection startPos (SUB1 i))) - (COND - ((NULL temp) - (push temp word)) - (T (NCONC1 temp word] - (COND - ((EQ charcode (CHARCODE %()) - (SETQ words (APPEND words temp)) - (SETQ temp NIL)) - ((EQ charcode (CHARCODE %))) - (SETQ words (APPEND words (LIST temp))) - (SETQ temp NIL] - (SETQ words (APPEND words temp)) - words]) -) -(DEFINEQ - -(TEdit.PrintPhraseSearch - [LAMBDA (stream dict words) (* jtm%: "26-May-87 09:26") - - (* * prints out the definitions that have a particular phrase in them.) - - (OR stream (SETQ stream (Dict.OutputStream))) - (DictTool.TEditWrapper (NerdForStream stream) - 'DictTool.PrintPhraseSearch stream words "Type phrase to search for:" - "Searching for phrase using" 'SEARCHPHRASE]) - -(DictTool.PrintPhraseSearch - [LAMBDA (dict selection stream) (* jtm%: "26-May-87 09:29") - (LET (looks words fn pos) - [SETQ words (COND - [(InvertedDict.Prop dict 'RemoteDict) - (DICTCLIENT.SEARCHFORPHRASE selection (InvertedDict.Prop dict 'RemoteDict] - ((SETQ fn (InvertedDict.Prop dict 'SEARCHFORPHRASEFN)) - (APPLY* fn dict selection] - (SETQ pos (TEDIT.GETPOINT stream)) - (TEDIT.INSERT stream (CONCAT "%"" selection "%": ")) - (SETQ looks (CONS pos (IDIFFERENCE (TEDIT.GETPOINT stream) - pos))) - [for word on words do (TEDIT.INSERT stream (CONCAT (CAR word) - (COND - ((CDR word) - "; ") - (T ""] - (TEDIT.INSERT stream (CHARACTER (CHARCODE CR))) - (TEDIT.INSERT stream (CHARACTER (CHARCODE CR))) (* do the looks last to avoid messing - up the text placement.) - (TEDIT.LOOKS stream '(FAMILY TIMESROMAN SIZE 10 FACE STANDARD) - 1 - (TEDIT.GETPOINT stream)) - (TEDIT.LOOKS stream '(FAMILY HELVETICA SIZE 10 FACE BOLD) - (CAR looks) - (CDR looks)) - words]) -) -(DEFINEQ - -(TEdit.PrintSynonyms - [LAMBDA (stream dict words) (* jtm%: "14-Oct-87 12:44") - - (* * prints out the synonyms of the selected word) - - (DictTool.TEditWrapper T 'DictTool.PrintSynonyms stream words "synonym to look up:" - "Getting synonyms for" 'USERSYNONYM]) - -(REMOVEALL - [LAMBDA (X L) (* jtm%: "14-Oct-87 12:39") - (for TAIL on X unless (EQUAL L (CAR TAIL)) collect (COND - ((LISTP (CAR TAIL)) - (REMOVEALL (CAR TAIL) - L)) - (T (COPY (CAR TAIL]) - -(CONVERTFUNCTIONSTOFORMS - [LAMBDA (LIST) (* jtm%: "14-Oct-87 12:57") - (for ELT in LIST collect (COND - [(EQ (CAR ELT) - 'FUNCTION) - (LIST 'QUOTE (LIST (CADR ELT] - ((LISTP ELT) - (CONVERTFUNCTIONSTOFORMS ELT)) - (T (COPY ELT]) - -(TEdit.PrintNounSynonyms - [LAMBDA (stream dict words) (* jtm%: "14-Oct-87 12:43") - - (* * prints out the synonyms of the selected word) - - (DictTool.TEditWrapper T (FUNCTION DictTool.PrintNounSynonyms) - stream words "synonym to look up:" "Getting noun synonyms for" 'USERSYNONYM]) - -(DictTool.PrintNounSynonyms - [LAMBDA (dict words stream) (* jtm%: "14-Oct-87 12:32") - (DictTool.PrintSynonyms dict words stream "n"]) - -(DictTool.PrintVerbSynonyms - [LAMBDA (dict words stream) (* jtm%: "14-Oct-87 12:34") - (DictTool.PrintSynonyms dict words stream "v"]) - -(DictTool.PrintAdjSynonyms - [LAMBDA (dict words stream) (* jtm%: "14-Oct-87 12:35") - (DictTool.PrintSynonyms dict words stream "adj"]) - -(TEdit.PrintVerbSynonyms - [LAMBDA (stream dict words) (* jtm%: "14-Oct-87 12:44") - - (* * prints out the synonyms of the selected word) - - (DictTool.TEditWrapper T 'DictTool.PrintVerbSynonyms stream words "synonym to look up:" - "Getting verb synonyms for" 'USERSYNONYM]) - -(TEdit.PrintAdjSynonyms - [LAMBDA (stream dict words) (* jtm%: "14-Oct-87 12:44") - - (* * prints out the synonyms of the selected word) - - (DictTool.TEditWrapper T 'DictTool.PrintAdjSynonyms stream words "synonym to look up:" - "Getting adjective synonyms for" 'USERSYNONYM]) - -(DictTool.PrintSynonyms - [LAMBDA (dict words stream form) (* jtm%: "14-Oct-87 12:31") - (PROG (synonyms found startPos headerPos endPos) - (for word inside words - do (SETQ synonyms (DICTCLIENT.SYNONYMS word)) - (AND synonyms (SETQ found T)) - (SETQ startPos (TEDIT.GETPOINT stream)) - (TEDIT.INSERT stream (CONCAT word ": ")) - (SETQ headerPos (TEDIT.GETPOINT stream)) - [for class in synonyms when (OR (NULL form) - (EQUAL form (CAR class))) - do (TEDIT.INSERT stream (CONCAT (CAR class) - ": ")) - [for word on (CDR class) do (TEDIT.INSERT stream (CONCAT (CAR word) - (COND - ((CDR word) - ", ") - (T ""] - (TEDIT.INSERT stream (CHARACTER (CHARCODE CR] - (TEDIT.INSERT stream (CHARACTER (CHARCODE CR))) - (SETQ endPos (TEDIT.GETPOINT stream)) - (TEDIT.LOOKS stream '(FAMILY HELVETICA SIZE 10 FACE BOLD) - startPos - (IDIFFERENCE (SUB1 headerPos) - startPos)) - (TEDIT.LOOKS stream '(FAMILY TIMESROMAN SIZE 10 FACE STANDARD) - headerPos - (IDIFFERENCE endPos headerPos)) - (TEDIT.SETSEL stream endPos 0 'LEFT)) - (RETURN found]) -) -(DEFINEQ - -(DictTool.TEditWrapper - [LAMBDA (dict proc stream selection promptString waitString cachePropName) - (* jtm%: "29-Jun-88 09:56") - - (* * handles the TEdit user interface) - - (PROG (scratchStream textStream startPos startTime textObj) - - (* * set things up) - - [COND - ((NULL stream) - (SETQ stream (Dict.OutputStream] - [COND - ((NULL dict) - (TEDIT.PROMPTPRINT stream "Please select a dictionary." T) - (RETURN)) - ((NULL selection) - (SETQ selection (TEDIT.SEL.AS.STRING stream)) - (COND - ((ILEQ (NCHARS selection) - 1) - (SETQ selection NIL))) - - (* * "rht 4/27/88: No longer passes value of PROMPTWINDOW textprop to MOUSECONFIRM since it could be DON'T. Now looks for promptwindow on the WINDOWPROP of the stream's main window.") - - (COND - [(AND selection (MOUSECONFIRM (CONCAT "CONFIRM INPUT: " selection) - "" - (CAR (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) - of (TEXTOBJ stream))) - 'PROMPTWINDOW] - ([NULL (SETQ selection (TEDIT.GETINPUT stream (OR promptString "input: ") - (AND cachePropName (STREAMPROP stream cachePropName] - (TEDIT.PROMPTPRINT stream " Aborted." T) - (RETURN] - - (* * print the results.) - - (SETQ startTime (CLOCK 0)) - (AND cachePropName (STREAMPROP stream cachePropName selection)) - (TEDIT.PROMPTPRINT stream (CONCAT (OR waitString "processing") - " '" selection "' . . . ") - T) - [RESETSAVE (OUTPUT (CAR (WINDOWPROP Dict.DefWindow 'PROMPTWINDOW] - (* redirects errors to the - promptwindow) - [SETQ scratchStream (OPENTEXTSTREAM NIL NIL NIL NIL '(LEAVETTY] - (COND - [(APPLY* proc dict selection scratchStream) - (TEDIT.INCLUDESTREAM (Dict.OutputStream) - scratchStream) - (COND - (DictTool.TimeOperation (TEDIT.PROMPTPRINT stream (CONCAT "Elapsed Time: " - (QUOTIENT - (DIFFERENCE (CLOCK 0) - startTime) - 1000.0) - " seconds."))) - (T (TEDIT.PROMPTPRINT stream "Done."] - (T (TEDIT.PROMPTPRINT stream "not found.") - (TEDIT.PROMPTFLASH stream))) - (CLOSEF scratchStream]) - -(Dict.OutputStream - [LAMBDA (REGION) (* ; "Edited 12-Oct-88 09:20 by rmk:") - (* ; "Edited 7-Oct-88 12:01 by jtm:") - (LET (TEXTSTREAM HIDDENFN UNHIDEFN) - [COND - ((AND Dict.DefWindow (NOT (OPENWP Dict.DefWindow)) - (WINDOWPROP Dict.DefWindow 'TEXTSTREAM)) (* window is shrunk.) - (OPENW Dict.DefWindow)) - ((AND Dict.DefWindow (CL:FIND-PACKAGE "ROOMS") - (SETQ HIDDENFN (CL:FIND-SYMBOL "WINDOW-HIDDEN?" "ROOMS")) - (GETD HIDDENFN) - (CL:FUNCALL HIDDENFN Dict.DefWindow)) - - (* the FIND-SYMBOL calls are used to avoid a break that happens when you access - the ROOMS package when it hasn't been loaded.) - - (SETQ UNHIDEFN (CL:FIND-SYMBOL "UN-HIDE-WINDOW" "ROOMS")) - (CL:FUNCALL UNHIDEFN Dict.DefWindow)) - ((OR (NULL Dict.DefWindow) - (NOT (OPENWP Dict.DefWindow))) - (SETQ Dict.DefWindow (CREATEW [OR REGION (AND Dict.DefWindow (WINDOWPROP Dict.DefWindow - 'REGION] - "Definitions")) - (SETQ TEXTSTREAM (OPENTEXTSTREAM NIL Dict.DefWindow)) - (replace TXTFILE of (TEXTOBJ TEXTSTREAM) with "Definitions") - - (* do the replace before you spawn a TEDIT process in order to avoid a race - condition where sometimes the label on the icon was "T") - - (PROCESSPROP (TEDIT TEXTSTREAM Dict.DefWindow NIL '(LEAVETTY)) - 'NAME - 'DICTIONARY] - (TEXTSTREAM Dict.DefWindow]) - -(DictTool.PromptStream - [LAMBDA (stream) (* jtm%: "29-Sep-86 11:11") - (COND - [(STREAMPROP stream) - (for window inside (STREAMPROP stream 'WINDOW) do (COND - ((WINDOWPROP window 'PROMPTWINDOW) - (RETURN (WINDOWPROP window ' - PROMPTWINDOW] - (T PROMPTWINDOW]) -) -(DEFINEQ - -(DictTool.Init - [LAMBDA (serverName) (* jtm%: "13-Oct-87 11:37") - (PROG (analyzer dict wordNerd) - - (* * start up the interface) - - (Dict.AddCommands) - - (* * create the analyzer) - - [Analyzer.Establish (SETQ analyzer (create Morphalyzer - analyzerName _ 'DictServer - openFn _ (FUNCTION DictTool.OpenAnalyzer) - closeFn _ (FUNCTION DictTool.Close) - analyzeFn _ (FUNCTION DictTool.Analyze) - correctionsFn _ (FUNCTION DictTool.Corrections] - (Analyzer.Prop analyzer 'CountWords (FUNCTION DictTool.CountWords)) - - (* * create the dictionary) - - [Dict.Establish (SETQ dict (create Dict - dictName _ 'DictServer - openFn _ (FUNCTION DictTool.OpenDictionary) - closeFn _ (FUNCTION DictTool.Close) - getEntryFn _ (FUNCTION DictTool.GetEntry) - printEntryFn _ (FUNCTION DictTool.PrintDefinition] - - (* * create the remote inverted dict.) - - [InvertedDict.Establish (SETQ wordNerd (create INVERTEDDICT - INVERTEDDICTNAME _ 'DictServer] - (InvertedDict.Prop wordNerd 'OPENFN (FUNCTION DictTool.OpenNerd)) - (InvertedDict.Prop wordNerd 'DICTIONARY dict]) - -(DictTool.Open - [LAMBDA (analyzer errors) (* jtm%: "13-Oct-87 10:43") - - (* * we import the interface here instead of in DictTool.Init to avoid hanging - the LOAD.) - - (PROG (analyzers dictionaries menuItems) - (COND - [(type? Morphalyzer analyzer) - (COND - ((NULL (Analyzer.Prop analyzer 'RemoteDict)) - (SETQ analyzers (DictTool.Analyzers analyzer errors)) - [SETQ menuItems (for i in analyzers collect (LIST i (LIST 'QUOTE i] - (COND - ((IGEQ 1 (LENGTH menuItems)) - (Analyzer.Prop analyzer 'RemoteDict (CAR analyzers))) - (T (Analyzer.Prop analyzer 'RemoteDict - (OR (MENU (create MENU - ITEMS _ menuItems - TITLE _ (CONCAT (fetch (Morphalyzer analyzerName) - of analyzer) - " analyzers") - CENTERFLG _ T)) - (CAR analyzers))) - (for i analyzerName in analyzers - do (SETQ analyzerName (MKATOM (CONCAT (fetch (Morphalyzer analyzerName) - of analyzer) - ": " i))) - (COND - ([NOT (for j in Analyzer.List thereis (EQ analyzerName ( - Analyzer.Name - j] - (push Analyzer.List (create Morphalyzer copying analyzer)) - (Analyzer.Prop (CAR Analyzer.List) - 'RemoteDict i] - ((type? Dict analyzer) - (COND - ((NULL (Dict.Prop analyzer 'RemoteDict)) - (SETQ dictionaries (DictTool.Dictionaries analyzer errors)) - [SETQ menuItems (for i in dictionaries collect (LIST i (LIST 'QUOTE i] - (COND - ((IGEQ 1 (LENGTH menuItems)) - (Dict.Prop analyzer 'RemoteDict (CAR dictionaries))) - (T (Dict.Prop analyzer 'RemoteDict - (OR (MENU (create MENU - ITEMS _ menuItems - TITLE _ (CONCAT (fetch (Dict dictName) of analyzer) - " dictionaries") - CENTERFLG _ T)) - (CAR dictionaries))) - (for i dictName in dictionaries - do (SETQ dictName (MKATOM (CONCAT (fetch (Dict dictName) of analyzer) - ": " i))) - (COND - ([NOT (for j in Dict.DictionaryList thereis (EQ dictName - (Dict.Name j] - (push Dict.DictionaryList (create Dict copying analyzer)) - (Dict.Prop (CAR Dict.DictionaryList) - 'RemoteDict i]) - -(DictTool.OpenDictionary - [LAMBDA (dict errors) (* jtm%: "13-Oct-87 10:38") - - (* * we import the interface here instead of in DictTool.Init to avoid hanging - the LOAD.) - - (PROG (dictionaries menuItems) - (COND - ((type? Dict dict) - (COND - ((NULL (Dict.Prop dict 'RemoteDict)) - (SETQ dictionaries (DICTCLIENT.DICTIONARIES)) - [SETQ menuItems (for i in dictionaries collect (LIST i (LIST 'QUOTE i] - (COND - ((IGEQ 1 (LENGTH menuItems)) - (Dict.Prop dict 'RemoteDict (CAR dictionaries))) - (T (Dict.Prop dict 'RemoteDict - (OR (MENU (create MENU - ITEMS _ menuItems - TITLE _ (CONCAT (fetch (Dict dictName) of dict) - " dictionaries") - CENTERFLG _ T)) - (CAR dictionaries))) - (for i dictName in dictionaries - do (SETQ dictName (MKATOM (CONCAT (fetch (Dict dictName) of dict) - ": " i))) - (COND - ([NOT (for j in Dict.DictionaryList thereis (EQ dictName - (Dict.Name j] - (push Dict.DictionaryList (create Dict copying dict)) - (Dict.Prop (CAR Dict.DictionaryList) - 'RemoteDict i]) - -(DictTool.OpenAnalyzer - [LAMBDA (analyzer errors) (* jtm%: "13-Oct-87 10:43") - - (* * we import the interface here instead of in DictTool.Init to avoid hanging - the LOAD.) - - (PROG (analyzers menuItems) - (COND - ((type? Morphalyzer analyzer) - (COND - ((NULL (Analyzer.Prop analyzer 'RemoteDict)) - (SETQ analyzers (DICTCLIENT.LANGUAGES)) - [SETQ menuItems (for i in analyzers collect (LIST i (LIST 'QUOTE i] - (COND - ((IGEQ 1 (LENGTH menuItems)) - (Analyzer.Prop analyzer 'RemoteDict (CAR analyzers))) - (T (Analyzer.Prop analyzer 'RemoteDict - (OR (MENU (create MENU - ITEMS _ menuItems - TITLE _ (CONCAT (fetch (Morphalyzer analyzerName) - of analyzer) - " analyzers") - CENTERFLG _ T)) - (CAR analyzers))) - (for i analyzerName in analyzers - do (SETQ analyzerName (MKATOM (CONCAT (fetch (Morphalyzer analyzerName) - of analyzer) - ": " i))) - (COND - ([NOT (for j in Analyzer.List thereis (EQ analyzerName ( - Analyzer.Name - j] - (push Analyzer.List (create Morphalyzer copying analyzer)) - (Analyzer.Prop (CAR Analyzer.List) - 'RemoteDict i]) - -(DictTool.OpenNerd - [LAMBDA (nerd errors) (* jtm%: "13-Oct-87 14:35") - - (* * we import the interface here instead of in DictTool.Init to avoid hanging - the LOAD.) - - (PROG (nerds menuItems dict remote) - (COND - ((type? INVERTEDDICT nerd) - (COND - ((NULL (InvertedDict.Prop nerd 'RemoteDict)) - (SETQ nerds (DICTCLIENT.RESOURCES 'INDICES)) - [SETQ menuItems (for i in nerds collect (LIST i (LIST 'QUOTE i] - (COND - ((IGEQ 1 (LENGTH menuItems)) - (InvertedDict.Prop nerd 'RemoteDict (CAR nerds))) - (T [InvertedDict.Prop nerd 'RemoteDict - (SETQ remote (OR (MENU (create MENU - ITEMS _ menuItems - TITLE _ (CONCAT (fetch (INVERTEDDICT - INVERTEDDICTNAME - ) of nerd) - " databases") - CENTERFLG _ T)) - (CAR nerds] - (COND - ((SETQ dict (InvertedDict.Prop nerd 'DICTIONARY)) - (SETQ dict (COPYALL dict)) - (Dict.Prop dict 'RemoteDict remote) - (InvertedDict.Prop nerd 'DICTIONARY dict))) - (for i in nerds do (COND - ((NOT (InvertedDictFromName (fetch (INVERTEDDICT - INVERTEDDICTNAME - ) - of nerd) - i)) - (push InvertedDict.List (create INVERTEDDICT - copying nerd)) - (InvertedDict.Prop (CAR InvertedDict.List) - 'RemoteDict i) - (COND - ((SETQ dict (InvertedDict.Prop (CAR - InvertedDict.List - ) - 'DICTIONARY)) - (SETQ dict (COPYALL dict)) - (Dict.Prop dict 'RemoteDict i) - (InvertedDict.Prop (CAR InvertedDict.List) - 'DICTIONARY dict]) - -(Dict.AddCommands - [LAMBDA NIL (* ; "Edited 27-Mar-91 17:19 by jtm:") - (* ; "Edited 31-May-89 15:06 by jtm:") - (* ; "Edited 31-May-89 15:00 by jtm:") - (* ; "Edited 31-May-89 13:36 by jtm:") - (LET (menuItems) - [SETQ menuItems '(Dictionary (FUNCTION TEdit.PrintDefinition) - "Prints the definition of the selected word. Prompts the user for a word if there isn't a selection." - (SUBITEMS (Set% Dictionary (FUNCTION TEdit.SetDictionary) - - "Gives the user a menu of dictionaries to select from." - ) - (Get% Definition (FUNCTION TEdit.PrintDefinition) - "Prints the definition of the selected word. Prompts the user for a word if there isn't a selection." - ) - (Get% Synonyms (FUNCTION TEdit.PrintSynonyms) - - "Prints the synonyms of the selected word. Prompts the user for a word if there isn't a selection." - (SUBITEMS (nouns (FUNCTION TEdit.PrintNounSynonyms) - "Only prints the noun form synonyms." - ) - (verbs (FUNCTION TEdit.PrintVerbSynonyms) - "Only prints the verb form synonyms.") - (adjectives (FUNCTION TEdit.PrintAdjSynonyms) - - "Only prints the adjective form synonyms." - ))) - (Relevance% Feedback (FUNCTION TEdit.SearchMenu)) - (|Search For Word| (FUNCTION TEdit.PrintSearch) - "Prints the words in the dictionary containing at least two of the keywords in the selection. Prompts the user for keywords if there aren't any keywords selected." - (SUBITEMS (Set% Database (FUNCTION TEdit.SetNerd) - - "Gives the user a menu of dictionaries to select from." - ) - (Max% Words (FUNCTION DictTool.PromptForCutoff) - - "Lets the user set the maximum number of words to be returned for a set of keywords." - ) - (Min% Keywords (FUNCTION - DictTool.PromptForKeywordCutoff - ) - - "Lets the user determine the minimum number of keywords needed by a word for it to accepted." - ) - (|Search For Phrase| (FUNCTION - TEdit.PrintPhraseSearch) - "Searches a dictionary for a particular phrase, using the Search For Word database to narrow the search. This can be an expensive operation, so please use it sparingly." - ] - (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU menuItems) - - (* ;; "add menu item to Lafite's display menu if Lafite has been loaded.") - - [COND - ((BOUNDP '\LAFITE.ACTIVE) - (pushnew LAFITE.EXTRA.DISPLAY.COMMANDS menuItems) - (if \LAFITE.ACTIVE - then (LAFITE.COMPUTE.CACHED.VARS] - (PUTASSOC 'Dictionary (CONVERTFUNCTIONSTOFORMS (CDR menuItems)) - BackgroundMenuCommands) - (SETQ BackgroundMenu NIL]) - -(DictTool.Close - [LAMBDA (analyzer) (* jtm%: "13-Nov-86 10:58") - (CLOSEF DICTSERVERSTREAM]) -) -(DEFINEQ - -(DictTool.Analyze - [LAMBDA (analyzer stream fromLoc length analFn) (* jtm%: "14-Apr-87 14:16") - (PROG (buffer bufferStream bufferLength char returnValue userWords (substring (ALLOCSTRING 0 32)) - (maxBufferLength 5100) - (offset fromLoc)) - (SETQ userWords (Analyzer.Prop analyzer 'UserDict)) - [COND - ((NULL stream) - NIL) - [(STRINGP stream) - (HELP "DictTool.Analyze not implemented for STRING") - [SETQ returnValue (DICTCLIENT.PROOFREAD stream (Analyzer.Prop analyzer 'RemoteDict] - (COND - ((EQUAL 0 (CDR returnValue)) - (RETURN (SETQ returnValue NIL] - (T - - (* * break up the stream into strings of ~5000 characters.) - - (SETQ buffer (ALLOCSTRING (IMIN length maxBufferLength))) - (SETQ bufferStream (OPENSTRINGSTREAM buffer 'OUTPUT)) - (SETFILEPTR stream fromLoc) - (while (IGREATERP length 0) - do (SETFILEPTR bufferStream 0) - (SETQ bufferLength 0) - [do (SETQ char (BIN stream)) - [COND - ((OR (NOT (NUMBERP char)) - (IGREATERP char 255)) - (SETQ char (CHARCODE % ] - (BOUT bufferStream char) - (add length -1) - (add bufferLength 1) - (COND - ((EQUAL length 0) - (RETURN)) - ((EQUAL bufferLength maxBufferLength) - (RETURN)) - ((IGREATERP bufferLength (IDIFFERENCE maxBufferLength 200)) - (COND - ([OR (EQ char (CHARCODE CR)) - (AND (EQ char (CHARCODE SP)) - (IGREATERP bufferLength (IDIFFERENCE maxBufferLength 50] - (RETURN] - [SETQ returnValue (DICTCLIENT.PROOFREAD (COND - ((EQUAL bufferLength (NCHARS buffer) - ) - buffer) - (T (SUBSTRING buffer 1 bufferLength - substring))) - (Analyzer.Prop analyzer 'RemoteDict] - (COND - ((EQUAL 0 (CDR returnValue)) - (SETQ returnValue NIL) - (add offset bufferLength)) - ((AND userWords (Dict.GetEntry userWords (SUBSTRING buffer - (ADD1 (CAR returnValue)) - (IPLUS (CAR returnValue) - (CDR returnValue)) - substring))) - [add length (IPLUS bufferLength (IMINUS (IPLUS (CAR returnValue) - (CDR returnValue] - (add offset (IPLUS (CAR returnValue) - (CDR returnValue))) - (SETFILEPTR stream offset) - (SETQ returnValue NIL)) - (returnValue (add (CAR returnValue) - offset) - (RETURN returnValue] - (RETURN returnValue]) - -(DictTool.Analyzers - [LAMBDA (analyzer errorStream) (* jtm%: "13-Nov-86 10:57") - - (* * wraps DictTool.RPCCall around a call to RemoteDict.Analyzers) - - (DICTCLIENT.LANGUAGES]) - -(DictTool.Pronunciation - [LAMBDA (word dictName) (* jtm%: "13-Nov-86 10:58") - [COND - ((NOT (STRINGP word)) - (SETQ word (MKSTRING word] - [COND - ((NULL dictName) - (SETQ dictName 'AmericanHeritage] - (DICTCLIENT.PRONUNCIATION word dictName]) - -(DictTool.Corrections - [LAMBDA (analyzer stream loc len) (* jtm%: "13-Nov-86 10:58") - (DICTCLIENT.CORRECTIONS (COND - ((STRINGP stream) - stream) - (T (STREAM.FETCHSTRING stream loc len))) - (Analyzer.Prop analyzer 'RemoteDict]) - -(DictTool.CountWords - [LAMBDA (analyzer stream fromLoc length analFn) (* jtm%: "13-Nov-86 14:19") - (PROG (buffer bufferStream bufferLength char (n 0) - (substring (ALLOCSTRING 0 32)) - (maxBufferLength 5100) - (offset fromLoc)) - [COND - ((NULL stream) - NIL) - [(STRINGP stream) - (HELP "DictTool.Analyze not implemented for STRING") - [SETQ n (DICTCLIENT.PROOFREAD stream (Analyzer.Prop analyzer 'RemoteDict] - (COND - ((EQUAL 0 (CDR n)) - (RETURN (SETQ n NIL] - (T - - (* * break up the stream into strings of ~5000 characters.) - - (SETQ buffer (ALLOCSTRING (IMIN length maxBufferLength))) - (SETQ bufferStream (OPENSTRINGSTREAM buffer 'OUTPUT)) - (SETFILEPTR stream fromLoc) - (while (IGREATERP length 0) - do (SETFILEPTR bufferStream 0) - (SETQ bufferLength 0) - [do (SETQ char (BIN stream)) - [COND - ((OR (NOT (NUMBERP char)) - (IGREATERP char 255)) - (SETQ char (CHARCODE % ] - (BOUT bufferStream char) - (add length -1) - (add bufferLength 1) - (COND - ((EQUAL length 0) - (RETURN)) - ((EQUAL bufferLength maxBufferLength) - (RETURN)) - ((IGREATERP bufferLength (IDIFFERENCE maxBufferLength 200)) - (COND - ([OR (EQ char (CHARCODE CR)) - (AND (EQ char (CHARCODE SP)) - (IGREATERP bufferLength (IDIFFERENCE maxBufferLength 50] - (RETURN] - [add n (DICTCLIENT.COUNTWORDS (COND - ((EQUAL bufferLength (NCHARS buffer)) - buffer) - (T (SUBSTRING buffer 1 bufferLength substring) - )) - (Analyzer.Prop analyzer 'RemoteDict] - (add offset bufferLength] - (RETURN n]) -) - (* * FINDWORD & SUBSTITUTEWORD) - -(DEFINEQ - -(DictTool.FindWord - [LAMBDA (STREAM WORD CH) (* jtm%: "30-Apr-86 10:30") - (* the TEDIT interface to FindWord) - (PROG (SEL (TEXTOBJ (TEXTOBJ STREAM))) - - (* * prompt the user for a string if none is given.) - - [COND - ((NULL WORD) - (SETQ WORD (TEDIT.GETINPUT TEXTOBJ "Word to find: " (WINDOWPROP W ' - TEDIT.LAST.FIND.STRING) - (CHARCODE (EOL LF ESC] - - (* * search for the word.) - - [COND - (WORD (SETQ SEL (fetch SEL of TEXTOBJ)) - (\SHOWSEL SEL NIL NIL) - (TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T) - (SETQ CH (LingFns.FindWord STREAM WORD CH)) - - (* * show the user what we found) - - (COND - (CH (TEDIT.PROMPTPRINT TEXTOBJ "Done.") - (replace CH# of SEL with (CAR CH)) - [replace DCH of SEL with (IPLUS (CAR CH) - (IMINUS (CADR CH] - (replace CHLIM of SEL with (ADD1 (CADR CH))) - (replace POINT of SEL with 'RIGHT) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\SHOWSEL SEL NIL T) - (WINDOWPROP W 'TEDIT.LAST.FIND.STRING WORD) - (* And get it into the window) - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found).") - (\SHOWSEL SEL NIL T] - (replace \INSERTNEXTCH of TEXTOBJ with -1]) - -(DictTool.SubstituteWord - [LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM? DICTNAME) (* jtm%: "24-Mar-87 08:58") - (* this procedure is a modification of - TEDIT.SUBSTITUTE.) - (PROG (SEARCHSTRING REPLACESTRING ABORTFLG OUTOFRANGEFLG (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - ENDCHAR# STARTCHAR# RANGE (REPLACEDFLG 0) - (YESLIST '("y" "Y" "yes" "Yes" "YES" "T")) - CONFIRMFLG SEL PC# SELCH# SELCHLIM SELPOINT CRSEEN DICT) - (COND - ([NULL (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search word:"] - (* If the search pattern is empty, - bail out.) - (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]") - (RETURN))) - (SETQ REPLACEMENT (OR REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace word:") - "")) (* jtm%: use REPLACEMENT for the - original, REPLACESTRING for the - modified word.) - (SETQ CRSEEN (STRPOS (CHARACTER (CHARCODE CR)) - REPLACEMENT)) (* jtm%: use REPLACEMENT instead of - REPLACESTRING) - (COND - (PATTERN (* If a pattern is specd in the call, - use the caller's confirm flag.) - (SETQ CONFIRMFLG CONFIRM?)) - (T (* Otherwise, ask for one.) - (SETQ CONFIRMFLG T) (* SETQ CONFIRMFLG (MEMBER - (TEDIT.GETINPUT TEXTOBJ - "Ask before each replace?" "Yes" - (CHARCODE (EOL SPACE ESCAPE LF TAB))) - YESLIST)) - (* jtm%: change default to "Yes") - )) - (TEDIT.PROMPTPRINT TEXTOBJ "Substituting..." T) - (SETQ DICT (DictTool.CreateConjugationMap DICTNAME SEARCHSTRING REPLACEMENT)) - (SETQ SEL (fetch SEL of TEXTOBJ)) (* STARTCHAR# and ENDCHAR# are the - bound of the search) - (\SHOWSEL SEL NIL NIL) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* Turn off any blue pending delete) - (SETQ STARTCHAR# (fetch CH# of SEL)) - [SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (fetch DCH of SEL] - (while (AND (SETQ RANGE (LingFns.FindWord TEXTSTREAM SEARCHSTRING STARTCHAR# DICT) - (* jtm%: use FindWord for TEDIT.FIND) - ) - (NOT ABORTFLG)) - do (SETQ REPLACESTRING (CADDR RANGE)) (* jtm%: add the suffix.) - [PROG (PENDING.SEL CHOICE) - (COND - [CONFIRMFLG (SETQ PENDING.SEL (TEDIT.SETSEL TEXTSTREAM (CAR RANGE) - (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE))) - 'RIGHT)) - (TEDIT.SHOWSEL TEXTSTREAM T PENDING.SEL) - (TEDIT.NORMALIZECARET TEXTOBJ SEL) - [SETQ CHOICE - (COND - [(LISTP REPLACESTRING) - (SETQ REPLACESTRING - (MENU (create MENU - ITEMS _ (CONS "*QUIT*" REPLACESTRING) - CENTERFLG _ T - CHANGEOFFSETFLG _ T - TITLE _ "substitutions"] - (T (TEDIT.GETINPUT TEXTOBJ (CONCAT "Substitute '" REPLACESTRING - "'? ['q' quits]") - "Yes" - (CHARCODE (EOL SPACE ESCAPE LF TAB] - (COND - ((MEMBER CHOICE '("*QUIT*" "Q" "q")) - (SETQ ABORTFLG T) - (GO L1)) - ((MEMBER CHOICE '(NIL "n" "N" "no" "NO")) - (* turn off selection) - (TEDIT.SHOWSEL TEXTSTREAM NIL PENDING.SEL) - (RPLACA RANGE (IDIFFERENCE (CADR RANGE) - (NCHARS REPLACESTRING))) - (GO L1)) - (T (* OK to replace) - (TEDIT.DELETE TEXTSTREAM PENDING.SEL) - (* make the replacement) - (COND - ((NOT (EQUAL REPLACESTRING "")) - (* If the replacestring is nothing, - why bother to add nothing) - (TEDIT.INSERT TEXTSTREAM REPLACESTRING (CAR RANGE)) - [SETQ ENDCHAR# (IPLUS ENDCHAR# - (IDIFFERENCE - (NCHARS REPLACESTRING) - (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE] - (add REPLACEDFLG 1] - (T (* No confirmation required. - Do the substitutions without showing - intermediate work) - (SETQ PC# (\DELETECH (CAR RANGE) - (CADR RANGE) - (ADD1 (IDIFFERENCE (CADR RANGE) - (CAR RANGE))) - TEXTOBJ)) - (\FIXDLINES (fetch LINES of TEXTOBJ) - SEL - (CAR RANGE) - (CADR RANGE) - TEXTOBJ) - [COND - ((NOT (EQUAL REPLACESTRING "")) - (* If the replacestring is nothing, - why bother to add nothing) - (COND - [CRSEEN (for ACHAR instring REPLACESTRING as NCH# - from (CAR RANGE) by 1 - do (SELCHARQ ACHAR - (CR (\INSERTCR ACHAR NCH# TEXTOBJ)) - (\INSERTCH ACHAR NCH# TEXTOBJ] - (T (\INSERTCH REPLACESTRING (CAR RANGE) - TEXTOBJ PC#))) - (SETQ ENDCHAR# (IPLUS ENDCHAR# (IDIFFERENCE - (NCHARS REPLACESTRING) - (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE] - (add REPLACEDFLG 1))) - L1 (SETQ STARTCHAR# (IPLUS (CAR RANGE) - (NCHARS REPLACESTRING] - (* start looking where you left off)) - (COND - ((ZEROP REPLACEDFLG) - (TEDIT.PROMPTPRINT TEXTOBJ "No replacements made." T)) - ((EQUAL REPLACEDFLG 1) - (TEDIT.PROMPTPRINT TEXTOBJ "1 Replacement made." T)) - (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (MKSTRING REPLACEDFLG) - " Replacements made.") - T))) - (COND - ((AND (NOT CONFIRMFLG) - (NOT (ZEROP REPLACEDFLG))) (* There WERE replacements, and they - were not confirmed.) - (replace CHLIM of SEL with ENDCHAR#) - [replace DCH of SEL with (ADD1 (IDIFFERENCE (fetch CHLIM of SEL) - (fetch CH# of SEL] - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (fetch CH# of SEL) - (fetch CHLIM of SEL)) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (RETURN REPLACEDFLG]) - -(DictTool.CreateConjugationMap - [LAMBDA (language word1 word2) (* jtm%: "24-Mar-87 09:06") - - (* * creates a conjugation dictionary that maps word1 into word2.) - - (PROG [fullconj1 fullconj2 pp1 pp2 prior (dict (SimpleDict.New 'map] - [COND - [word2 (SETQ fullconj1 (DICTCLIENT.CONJUGATE word1 NIL NIL language)) - (SETQ fullconj2 (DICTCLIENT.CONJUGATE word2 NIL NIL language)) - (SETQ pp1 (FASSOC 'pp fullconj1)) - (SETQ pp2 (FASSOC 'pp fullconj2)) - [COND - [(AND pp1 (NULL pp2) - (FASSOC 'v fullconj2)) - (push fullconj2 (CONS 'pp (CDR (FASSOC 'pst fullconj2] - ((AND pp2 (NULL pp1) - (FASSOC 'v fullconj1)) - (push fullconj1 (CONS 'pp (CDR (FASSOC 'pst fullconj1] - (for conj1 conj2 entry in fullconj1 - do (SETQ conj2 (FASSOC (CAR conj1) - fullconj2)) - (AND conj2 (for caps oldValue newValue in '(NONE FIRST ALL) - do (SETQ entry (LingFns.Capitalize (CADR conj1) - caps)) - (SETQ oldValue (Dict.GetEntry dict entry)) - (SETQ newValue (LingFns.Capitalize (CADR conj2) - caps)) - (SETQ newValue (COND - ((for i inside oldValue - thereis (STREQUAL i newValue)) - oldValue) - ((LISTP oldValue) - (CONS newValue oldValue)) - (oldValue (LIST newValue oldValue)) - (T newValue))) - (Dict.PutEntry dict entry newValue] - (T (for conjugation in (DICTCLIENT.CONJUGATE word1 NIL language) - do (for caps in '(NONE FIRST ALL) do (Dict.PutEntry dict (LingFns.Capitalize - (CADR conjugation) - caps) - T] - (RETURN dict]) - -(DictTool.FindWordInit - [LAMBDA NIL (* jtm%: "26-Feb-87 13:46") - - (* * add items to TEDIT's menu.) - - [for ITEM on (fetch (MENU ITEMS) of TEDIT.DEFAULT.MENU) - do (COND - [(EQ (CAR ITEM) - 'Find) - (RPLACA ITEM '(Find 'Find NIL (SUBITEMS (FindWord (FUNCTION DictTool.FindWord) - - "Looks for a word independent of its inflection or capitalization." - ] - ((EQ (CAR ITEM) - 'Substitute) - (RPLACA ITEM '(Substitute 'Substitute NIL (SUBITEMS (SubstituteWord - (FUNCTION DictTool.SubstituteWord) - - "Substitutes one word for another, keeping the same capitalization and inflectional form." - ] - - (* * force the menu to be recomputed.) - - (COND - ((EQ (fetch MENUCOLUMNS of TEDIT.DEFAULT.MENU) - 1) (* If there is only one column, force - a re-figuring of the number of rows) - (replace MENUROWS of TEDIT.DEFAULT.MENU with NIL)) - ((EQ (fetch MENUROWS of TEDIT.DEFAULT.MENU) - 1) (* There's only one row, so recompute - %# of columns.) - (replace MENUCOLUMNS of TEDIT.DEFAULT.MENU with NIL))) - (replace ITEMWIDTH of TEDIT.DEFAULT.MENU with 10000) - (replace ITEMHEIGHT of TEDIT.DEFAULT.MENU with 10000) - (replace IMAGE of TEDIT.DEFAULT.MENU with NIL) (* Force it to create a new menu - image.) - (UPDATE/MENU/IMAGE TEDIT.DEFAULT.MENU]) -) -(DEFINEQ - -(LingFns.FindWord - [LAMBDA (STREAM WORD CH DICT) (* jtm%: "24-Mar-87 09:28") - - (* * finds the next instance of WORD in the text stream, independent of how it is - conjugated or capitalized. returns the first character index, the last character - index, the suffix, and the capitalization.) - - (PROG (CHAR NODE END EXPO FIRSTCHAR LASTCHAR U-FIRSTCHAR EOFPTR dictCreated) - - (* * build the dictionary) - - [COND - (WORD (SETQ WORD (MKSTRING WORD)) - [COND - ((NULL DICT) - (SETQ DICT (STREAMPROP STREAM 'FINDWORDMAP)) - (COND - ((EQUAL WORD (CAR DICT)) - (SETQ DICT (CDR DICT))) - (T (SETQ DICT (DictTool.CreateConjugationMap NIL WORD)) - (STREAMPROP STREAM 'FINDWORDMAP (CONS WORD DICT] - - (* * initialize.) - - [COND - ((NULL CH) - (SETQ CH (TEDIT.GETPOINT STREAM] - (SETQ CH (SUB1 CH)) - (SETQ EOFPTR (GETEOFPTR STREAM)) - (COND - ((GREATERP CH EOFPTR) - (RETURN)) - (T (SETFILEPTR STREAM CH))) - [SETQ FIRSTCHAR (CHCON1 (L-CASE (NTHCHAR WORD 1] - [SETQ U-FIRSTCHAR (CHCON1 (U-CASE (NTHCHAR WORD 1] - - (* * search for a word that begins with the first letter.) - - (while (NEQ EOFPTR (GETFILEPTR STREAM)) - do (SETQ LASTCHAR CHAR) - (SETQ CHAR (BIN STREAM)) - (COND - ([AND [OR (NULL LASTCHAR) - (AND (NUMBERP LASTCHAR) - (NOT (ALPHACHARP LASTCHAR] - (NUMBERP CHAR) - (SETQ NODE (FASSOC (CHARACTER CHAR) - (fetch (SimpleDict.Node subnodes) - of (fetch (Dict contents) of DICT] - (SETQ CH (GETFILEPTR STREAM)) - [while NODE do (COND - ((EQP EOFPTR (GETFILEPTR STREAM)) - (SETQ END EOFPTR) - (RETURN)) - ([AND (SETQ CHAR (BIN STREAM)) - (NUMBERP CHAR) - (ALPHACHARP CHAR) - (SETQ NODE (FASSOC (CHARACTER CHAR) - (fetch (SimpleDict.Node - subnodes) - of NODE] - (* is this a legal character?) - ) - (T (RETURN] - (COND - ((SETQ EXPO (fetch (SimpleDict.Node value) of NODE)) - (RETURN] - - (* * we are done.) - - (RETURN (COND - ((AND EXPO CH) - [COND - ((NULL END) - (SETQ END (SUB1 (GETFILEPTR STREAM] - (LIST CH END EXPO]) - -(LingFns.Capitalize - [LAMBDA (word caps) (* jtm%: " 6-Aug-84 12:53") - - (* * capitalizes word according to the parameter "caps") - - (COND - ((LISTP word) - (for w in word collect (LingFns.Capitalize w caps))) - (T (PROG (stringP litAtom) - (COND - ((STRINGP word) - (SETQ word (UNPACK word)) - (SETQ stringP T)) - ((LITATOM word) - (SETQ word (UNPACK word)) - (SETQ litAtom T))) - [SELECTQ caps - (FIRST [COND - ((NOT (U-CASEP (CAR word))) - (RPLACA word (U-CASE (CAR word] - [for char on (CDR word) do (COND - ((U-CASEP (CAR char)) - (RPLACA char (L-CASE (CAR char]) - (ALL [for char on word do (COND - ((NOT (U-CASEP (CAR char))) - (RPLACA char (U-CASE (CAR char]) - (for char on word do (COND - ((U-CASEP (CAR char)) - (RPLACA char (L-CASE (CAR char] - [COND - [stringP (SETQ word (MKSTRING (PACK word] - (litAtom (SETQ word (PACK word] - (RETURN word]) - -(LingFns.Capitalization - [LAMBDA (word) (* jtm%: "18-Jul-84 15:19") - - (* * returns NIL, ALL or FIRST) - - (COND - ([OR (NULL word) - (NOT (U-CASEP (CAR word] - NIL) - ([OR (NULL (CDR word)) - (NOT (U-CASEP (CADR word] - 'FIRST) - (T 'ALL]) -) - -(DictTool.FindWordInit) - -(RPAQ? DictTool.TimeOperation NIL) - -(RPAQ? Dict.DefWindow NIL) - -(RPAQ? Dict.CommandsAdded NIL) - -(RPAQ? InvertedDict.List NIL) - -(RPAQ? DictTool.LastSearch NIL) - -(RPAQ? DictTool.LastWord NIL) - -(RPAQ? TEdit.DefaultDictionary NIL) - -(RPAQ? DictTool.MinKeywords 2) - -(RPAQ? DictTool.MaxWords 100) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS DictTool.TimeOperation Dict.DefWindow Dict.CommandsAdded InvertedDict.List - DictTool.MinKeywords DictTool.MaxWords DictTool.LastSearch DictTool.LastWord - TEdit.DefaultDictionary) -) - -(DictTool.Init) - -(RPAQQ PronunciationGuide - (("q" "cat" "(kqt)") - ("A" "pay" "(pA)") - ("Q" "care" "(kQr)") - ("*" "father" "(f*%"T5r)") - ("b" "bike" "(bIk)") - ("ch" "church" "(ch/rch)") - ("d" "deed" "(dEd)") - ("4" "pet" "(p4t)") - ("E" "seed" "(sEd)") - ("I" "fife" "(fIf)") - ("g" "gag" "(gqg)") - ("h" "hat" "(hqt)") - ("hw" "which" "(hw9ch)") - ("9" "pit" "(p9t)") - ("I" "lie" "(lI)") - ("7" "pier" "(p7r)") - ("j" "judge" "(j8j)") - ("k" "kick" "(k9k)") - ("l" "lid" "(l9d)") - ("l" "needle" "(nEd%"l)") - ("m" "mum" "(m8m)") - ("n" "no, sudden" "(nO)") - ("ng" "thing" "(th9ng)") - ("0" "pot" "(p0t)") - ("O" "toe" "(tO)") - ("" "paw" "(p)") - ("oi" "noise" "(noiz)") - ("ou" "out" "(out)") - ("1" "book" "(b1k)") - ("|" "boot" "(b|t)") - ("p" "people" "(pE%"p5l)") - ("r" "roar" "(rr)") - ("s" "sauce" "(ss)") - ("sh" "ship" "(sh9p)") - ("t" "tight" "(tIt)") - ("th" "thin" "(th9n)") - ("T" "this" "(T9s)") - ("8" "cut" "(k8t)") - ("/" "urge" "(/rj)") - ("v" "valve" "(vqlv)") - ("w" "with" "(w9T, w9th)") - ("y" "yes" "(y4s)") - ("z" "zebra" "(zE%"br5)") - ("zh" "vision" "(v9zh%"5n)") - ("5" "about" "(5-bout%")") - ("KH" "loch" "(l0KH, l0k)") - ("N" "bon" "(b0n; French bN)."))) - -(RPAQQ PronunciationMap - ((%" %') - (5 ÿ&fÿ) - (/ Ï u) - (8 Æ u) - (T Î t h) - (%| Å o Å o) - (1 Æ o Æ o) - (% ÿñÑÿ) - (O Å o) - (0 Æ o) - (7 ÿñÀÿ) - (I ÿñ¿ÿ) - (9 ÿñ¾ÿ) - (E Å e) - (4 Æ e) - (* ÿñ§ÿ) - (Q ÿñ£ÿ) - (A Å a) - (q Æ a))) -(PUTPROPS DICTTOOL COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1991 1994)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (6206 19012 (TEDIT.INCLUDESTREAM 6216 . 6727) (TEdit.PrintDefinition 6729 . 8983) ( -DictTool.PrintDefinition 8985 . 11522) (Dict.PrintDefinition 11524 . 12487) (DictTool.GetEntry 12489 - . 12788) (TEdit.SetDictionary 12790 . 14949) (DictForStream 14951 . 15318) (DictTool.Dictionaries -15320 . 15474) (PARSEBYCOLONS 15476 . 16525) (PrintPronunciationGuide 16527 . 17998) ( -ConvertPronunciation 18000 . 19010)) (19013 28606 (TEdit.SearchMenu 19023 . 19253) (TEdit.PrintSearch -19255 . 19705) (DictTool.PrintSearch 19707 . 21970) (DictTool.MergeSearch 21972 . 23800) ( -NerdForStream 23802 . 24112) (TEdit.SetNerd 24114 . 26186) (DictTool.PromptForCutoff 26188 . 26735) ( -DictTool.PromptForKeywordCutoff 26737 . 27385) (PARSESELECTION 27387 . 28604)) (28607 30662 ( -TEdit.PrintPhraseSearch 28617 . 29079) (DictTool.PrintPhraseSearch 29081 . 30660)) (30663 35458 ( -TEdit.PrintSynonyms 30673 . 31002) (REMOVEALL 31004 . 31504) (CONVERTFUNCTIONSTOFORMS 31506 . 31996) ( -TEdit.PrintNounSynonyms 31998 . 32349) (DictTool.PrintNounSynonyms 32351 . 32535) ( -DictTool.PrintVerbSynonyms 32537 . 32721) (DictTool.PrintAdjSynonyms 32723 . 32908) ( -TEdit.PrintVerbSynonyms 32910 . 33252) (TEdit.PrintAdjSynonyms 33254 . 33599) (DictTool.PrintSynonyms -33601 . 35456)) (35459 41047 (DictTool.TEditWrapper 35469 . 38707) (Dict.OutputStream 38709 . 40503) ( -DictTool.PromptStream 40505 . 41045)) (41048 59057 (DictTool.Init 41058 . 42788) (DictTool.Open 42790 - . 46641) (DictTool.OpenDictionary 46643 . 48538) (DictTool.OpenAnalyzer 48540 . 50723) ( -DictTool.OpenNerd 50725 . 54089) (Dict.AddCommands 54091 . 58906) (DictTool.Close 58908 . 59055)) ( -59058 66664 (DictTool.Analyze 59068 . 63116) (DictTool.Analyzers 63118 . 63348) ( -DictTool.Pronunciation 63350 . 63670) (DictTool.Corrections 63672 . 64038) (DictTool.CountWords 64040 - . 66662)) (66703 84035 (DictTool.FindWord 66713 . 68724) (DictTool.SubstituteWord 68726 . 78941) ( -DictTool.CreateConjugationMap 78943 . 81818) (DictTool.FindWordInit 81820 . 84033)) (84036 89838 ( -LingFns.FindWord 84046 . 87864) (LingFns.Capitalize 87866 . 89478) (LingFns.Capitalization 89480 . -89836))))) -STOP diff --git a/lispusers/DICTTOOL.LCOM b/lispusers/DICTTOOL.LCOM deleted file mode 100644 index 2e775e95c..000000000 Binary files a/lispusers/DICTTOOL.LCOM and /dev/null differ diff --git a/lispusers/PROOFREADER b/lispusers/PROOFREADER deleted file mode 100644 index 846a28edb..000000000 --- a/lispusers/PROOFREADER +++ /dev/null @@ -1,613 +0,0 @@ -(FILECREATED "13-Oct-87 12:01:34" {QV}TOOLS>PROOFREADER.;34 22618 - - changes to: (FNS Proofreader.New) - - previous date: " 6-Feb-87 16:02:15" {QV}TOOLS>PROOFREADER.;33) - - -(* Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.) - -(PRETTYCOMPRINT PROOFREADERCOMS) - -(RPAQQ PROOFREADERCOMS [(FILES ANALYZER SPELLINGARRAY) - (FNS Proofreader.New Proofreader.Open Proofreader.AddEntry - Proofreader.Lookup Proofreader.AllForms) - (FNS Proofreader.CharTable Proofreader.LookupBit Proofreader.SetBit) - (FNS Proofreader.Correct Proofreader.NextWord) - (MACROS Proofreader.Hash1 Proofreader.Hash2 \Proofreader.TestCorruption) - (INITVARS Proofreader Proofreader.AutoLoad Proofreader.Lisp) - (* Proofreader.AutoLoad is a file or list of files to be loaded whenever a - proofreader is opened.) - (P (Analyzer.Establish (SETQ Proofreader (Proofreader.New (QUOTE - Proofreader]) -(FILESLOAD ANALYZER SPELLINGARRAY) -(DEFINEQ - -(Proofreader.New - [LAMBDA (name fileName) (* jtm: "13-Oct-87 11:57") - (PROG [(analyzer (create Morphalyzer - analyzerName _ name - openFn _(FUNCTION Proofreader.Open) - lookupFn _(FUNCTION Proofreader.Lookup) - addEntryFn _(FUNCTION Proofreader.AddEntry] - (RETURN analyzer]) - -(Proofreader.Open - [LAMBDA (analyzer stream) (* jtm: " 6-Feb-87 15:24") - (COND - ((NULL (fetch (Morphalyzer index) of analyzer)) - [replace (Morphalyzer index) of analyzer - with (PROG [(file (Analyzer.Prop analyzer (QUOTE FileName] - [COND - ((AND (NULL SpellingArray) - (NULL file)) - (ERROR "No Spelling Array for" analyzer)) - ((NULL SpellingArray) - (COND - ((NULL stream) - (PROMPTPRINT "initializing Proofreader")) - (T (TEDIT.PROMPTPRINT stream "initializing Proofreader" T))) - (RESETLST (PROG (LENGTH ALENGTH BLOCK STREAM (START 0) - (HEADERSIZE 6)) - [RESETSAVE (SETQ STREAM (OPENSTREAM - file - (QUOTE INPUT) - (QUOTE OLD))) - (QUOTE (PROGN (CLOSEF OLDVALUE] - (SETQ LENGTH (IDIFFERENCE (GETFILEINFO - file - (QUOTE LENGTH)) - (IPLUS HEADERSIZE 2) - )) - (for i from 1 to HEADERSIZE - do (BIN STREAM)) - (* skip header) - (while (ILESSP START LENGTH) - do (SETQ ALENGTH (MIN 64000 - (IDIFFERENCE - LENGTH START))) - (SETQ BLOCK - (\ALLOCBLOCK (LRSH (IPLUS 3 ALENGTH) - 2))) - (\BINS STREAM BLOCK 0 ALENGTH) - (add START ALENGTH) - (push SpellingArray (CONS START BLOCK))) - (SETQ SpellingArray (REVERSE SpellingArray] - (RETURN (CONS SpellingArray (Proofreader.CharTable] - (for file inside Proofreader.AutoLoad do (Analyzer.DefaultLoadWordList analyzer file]) - -(Proofreader.AddEntry - [LAMBDA (analyzer lemma entry dontRecord) (* jtm: " 6-Feb-87 15:24") - - (* * adds "lemma" to the SpellingArray. This procedure is just like Lookup, only it sets the bits rather than just  - reading them.) - - - (PROG (char p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 hashArray - hashArray.CharTable start length) (* first save the word on a property list.) - (COND - ((NULL dontRecord) - (Analyzer.PushProp analyzer (QUOTE WordList) - lemma))) - (SETQ hashArray (fetch (Morphalyzer index) of analyzer)) - [COND - ((NULL entry) - (SETQ entry (Proofreader.AllForms lemma] - [COND - ((NULL hashArray) - (Proofreader.Open analyzer) - (SETQ hashArray (fetch (Morphalyzer index) of analyzer] - (SETQ hashArray.CharTable (CDR hashArray)) - (SETQ hashArray (CAR hashArray)) - (SETQ hash1 953) - (SETQ hash2 63869) - (SETQ hash3 2441) - (SETQ hash4 62265) - (SETQ hash5 4079) - (SETQ hash6 60585) - (SETQ hash7 5807) - (SETQ p 359) - (Stream.Init lemma start length) - (while (SETQ char (Stream.NextChar lemma length start)) - do [COND - ((ALPHACHARP char) - (SETQ char (ELT hashArray.CharTable (IDIFFERENCE char 64] - (add p 1009) - (SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 - hash2)) - p))) - [SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2 - hash3) - char] - [SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4) - char] - (SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2 - hash5)) - p))) - (SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 - hash6)) - p))) - (SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2 - hash7) - char) - p))) - [SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1 - hash1) - char] - (SETQ hash1 x1) - (SETQ hash2 x2) - (SETQ hash3 x3) - (SETQ hash4 x4) - (SETQ hash5 x5) - (SETQ hash6 x6) - (SETQ hash7 x7)) - - (* * set the bits.) - - - (Proofreader.SetBit hash1 hash7 hashArray) - (Proofreader.SetBit hash2 hash6 hashArray) - (Proofreader.SetBit hash3 hash5 hashArray) - (Proofreader.SetBit hash4 hash4 hashArray) - (Proofreader.SetBit hash5 hash3 hashArray) - (Proofreader.SetBit hash6 hash2 hashArray) - (Proofreader.SetBit hash7 hash1 hashArray) - (RETURN lemma]) - -(Proofreader.Lookup - [LAMBDA (analyzer stream start length) (* jtm: " 6-Feb-87 15:25") - - (* * hashes the string into the array using a probabalistic technique. This may produce a false positive.) - - - (PROG (char word p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 hashArray - hashArray.CharTable) - (SETQ hashArray (fetch (Morphalyzer index) of analyzer)) - [COND - ((NULL hashArray) - (Proofreader.Open analyzer) - (SETQ hashArray (fetch (Morphalyzer index) of analyzer] - (SETQ hashArray.CharTable (CDR hashArray)) - (SETQ hashArray (CAR hashArray)) - (SETQ hash1 953) - (SETQ hash2 63869) - (SETQ hash3 2441) - (SETQ hash4 62265) - (SETQ hash5 4079) - (SETQ hash6 60585) - (SETQ hash7 5807) - (SETQ p 359) - (Stream.Init stream start length) - (while (SETQ char (Stream.NextChar stream length start)) - do [COND - ((IGREATERP char 255) - (SETQ char (IMOD char 256] - [COND - ((ALPHACHARP char) - (SETQ char (ELT hashArray.CharTable (IDIFFERENCE char 64] - (add p 1009) - (SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 - hash2)) - p))) - [SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2 - hash3) - char] - [SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4) - char] - (SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2 - hash5)) - p))) - (SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 - hash6)) - p))) - (SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2 - hash7) - char) - p))) - [SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1 - hash1) - char] - (SETQ hash1 x1) - (SETQ hash2 x2) - (SETQ hash3 x3) - (SETQ hash4 x4) - (SETQ hash5 x5) - (SETQ hash6 x6) - (SETQ hash7 x7)) - (COND - ((AND (Proofreader.LookupBit hash1 hash7 hashArray) - (Proofreader.LookupBit hash2 hash6 hashArray) - (Proofreader.LookupBit hash3 hash5 hashArray) - (Proofreader.LookupBit hash4 hash4 hashArray) - (Proofreader.LookupBit hash5 hash3 hashArray) - (Proofreader.LookupBit hash6 hash2 hashArray) - (Proofreader.LookupBit hash7 hash1 hashArray)) - (RETURN T]) - -(Proofreader.AllForms - [LAMBDA (lemma) (* jtm: " 6-Feb-87 15:25") - - (* * ask the user for the forms to fill out this word.) - - - (PROG (forms form newForms menuPos) - (SETQ forms (LIST (QUOTE NOUN) - (QUOTE VERB) - (QUOTE ADJ) - (English.Suffix lemma "s") - (English.Suffix lemma "s") - (English.Suffix lemma "er") - " " - (English.Suffix lemma "ed") - (English.Suffix lemma "est") - " " - (English.Suffix lemma "ing") - " " " " (QUOTE *OTHER*))) - (while [SETQ form - (MENU (create MENU - TITLE _ "parts of speech" - CENTERFLG _ T - ITEMS _ forms - MENUCOLUMNS _ 3 - CHANGEOFFSETFLG _ T - MENUPOSITION _(COND - (menuPos) - (T (GETMOUSESTATE) - (SETQ menuPos (CONS LASTMOUSEX LASTMOUSEY] - do (pushnew newForms form)) - (RETURN newForms]) -) -(DEFINEQ - -(Proofreader.CharTable - [LAMBDA NIL (* jtm: " 6-Feb-87 15:27") - - (* * comment) - - - (PROG (SpellingArray.CharTable) - (SETQ SpellingArray.CharTable (ARRAY 58)) - (for i in (QUOTE (0 32)) - do (SETA SpellingArray.CharTable (IPLUS i 1) - 65325) - (SETA SpellingArray.CharTable (IPLUS i 2) - 65204) - (SETA SpellingArray.CharTable (IPLUS i 3) - 449) - (SETA SpellingArray.CharTable (IPLUS i 4) - 588) - (SETA SpellingArray.CharTable (IPLUS i 5) - 7102) - (SETA SpellingArray.CharTable (IPLUS i 6) - 64682) - (SETA SpellingArray.CharTable (IPLUS i 7) - 64545) - (SETA SpellingArray.CharTable (IPLUS i 8) - 64418) - (SETA SpellingArray.CharTable (IPLUS i 9) - 1278) - (SETA SpellingArray.CharTable (IPLUS i 10) - 1433) - (SETA SpellingArray.CharTable (IPLUS i 11) - 63968) - (SETA SpellingArray.CharTable (IPLUS i 12) - 63827) - (SETA SpellingArray.CharTable (IPLUS i 13) - 1874) - (SETA SpellingArray.CharTable (IPLUS i 14) - 2027) - (SETA SpellingArray.CharTable (IPLUS i 15) - 2180) - (SETA SpellingArray.CharTable (IPLUS i 16) - 63195) - (SETA SpellingArray.CharTable (IPLUS i 17) - 63058) - (SETA SpellingArray.CharTable (IPLUS i 18) - 62865) - (SETA SpellingArray.CharTable (IPLUS i 19) - 2798) - (SETA SpellingArray.CharTable (IPLUS i 20) - 2963) - (SETA SpellingArray.CharTable (IPLUS i 21) - 62372) - (SETA SpellingArray.CharTable (IPLUS i 22) - 62216) - (SETA SpellingArray.CharTable (IPLUS i 23) - 62067) - (SETA SpellingArray.CharTable (IPLUS i 24) - 3624) - (SETA SpellingArray.CharTable (IPLUS i 25) - 3793) - (SETA SpellingArray.CharTable (IPLUS i 26) - 3944)) - (RETURN SpellingArray.CharTable]) - -(Proofreader.LookupBit - [LAMBDA (row column SpellingArray) (* jtm: " 6-Feb-87 15:27") - - (* * There are 4096 bits per row, but only 4093 of them are used.) - - - (PROG (byte (startByte 0)) - (SETQ row (IMOD row 199)) - (SETQ column (IMOD column 4093)) - (SETQ byte (IPLUS (LLSH row 9) - (LRSH column 3))) - (for block in SpellingArray - do (COND - ((ILESSP byte (CAR block)) - (SETQ byte (\GETBASEBYTE (CDR block) - (IDIFFERENCE byte startByte))) - (RETURN))) - (SETQ startByte (CAR block))) - (RETURN (BITTEST byte (MASK.1'S (IDIFFERENCE 7 (LOGAND column 7)) - 1]) - -(Proofreader.SetBit - [LAMBDA (row column SpellingArray) (* jtm: " 6-Feb-87 15:28") - - (* * There are 4096 bits per row, but only 4093 of them are used.) - - - (PROG (address (startByte 0)) - (SETQ row (IMOD row 199)) - (SETQ column (IMOD column 4093)) - (SETQ address (IPLUS (LLSH row 9) - (LRSH column 3))) - (for block byte in SpellingArray - do (COND - ((ILESSP address (CAR block)) - (SETQ byte (\GETBASEBYTE (CDR block) - (IDIFFERENCE address startByte))) - (SETQ byte (BITSET byte (MASK.1'S (IDIFFERENCE 7 (LOGAND column 7)) - 1))) - (\PUTBASEBYTE (CDR block) - (IDIFFERENCE address startByte) - byte) - (RETURN))) - (SETQ startByte (CAR block]) -) -(DEFINEQ - -(Proofreader.Correct - [LAMBDA (analyzer stream start length) (* jtm: " 6-Feb-87 15:28") - - (* * returns a list of possible spelling corrections for the given word.) - - - (PROG (form word wordList caps periods) - [COND - ((NOT (LISTP stream)) - (SETFILEPTR stream start) - (SETQ word (for i from 1 to length collect (READC stream] - (SETQ caps (Analyzer.Capitalization word)) - (SETQ periods (FMEMB (QUOTE %.) - word)) - - (* * first try transpositions) - - - (for tail temp on word while (CDR tail) - do (SETQ temp (CAR tail)) - (RPLACA tail (CADR tail)) - (RPLACA (CDR tail) - temp) - (COND - ((AND (EQ caps (QUOTE FIRST)) - (EQ tail word)) (* don't transpose the first letters of a capitalized  - word.) - NIL) - (T (\Proofreader.TestCorruption analyzer word wordList))) - (RPLACA (CDR tail) - (CAR tail)) - (RPLACA tail temp)) - - (* * next try deletions) - - - (COND - ((CDR word) - (\Proofreader.TestCorruption analyzer (CDR word) - wordList))) - (for tail temp on word while (CDR tail) - do (SETQ temp (CDR tail)) - (RPLACD tail (CDDR tail)) - (\Proofreader.TestCorruption analyzer word wordList) - (RPLACD tail temp)) - - (* * prepend a character.) - - - (SETQ word (CONS (QUOTE A) - word)) - (SELECTQ caps - (FIRST (* don't prepend a character before a capitalized  - word.) - NIL) - (ALL (* prepend a capital letter.) - (for c from (CHARCODE A) to (CHARCODE Z) - do (RPLACA word (CHARACTER c)) - (\Proofreader.TestCorruption analyzer word wordList))) - (for c from (CHARCODE a) to (CHARCODE z) - do (RPLACA word (CHARACTER c)) - (\Proofreader.TestCorruption analyzer word wordList))) - (SETQ word (CDR word)) - - (* * insert characters.) - - - (for tail on word - do (RPLACD tail (CONS (QUOTE A) - (CDR tail))) - [COND - ((EQ caps (QUOTE ALL)) - (for c from (CHARCODE A) to (CHARCODE Z) - do (RPLACA (CDR tail) - (CHARACTER c)) - (\Proofreader.TestCorruption analyzer word wordList))) - (T (for c from (CHARCODE a) to (CHARCODE z) - do (RPLACA (CDR tail) - (CHARACTER c)) - (\Proofreader.TestCorruption analyzer word wordList] - (COND - (periods (RPLACA (CDR tail) - (QUOTE %.)) - (\Proofreader.TestCorruption analyzer word wordList))) - (RPLACD tail (CDDR tail))) - - (* * replace characters) - - - (for tail temp on word - do (SETQ temp (CAR tail)) - [COND - ((OR (EQ caps (QUOTE ALL)) - (AND (EQ caps (QUOTE FIRST)) - (EQ tail word))) - (for c from (CHARCODE A) to (CHARCODE Z) - do (COND - ((NEQ temp (CHARACTER c)) - (RPLACA tail (CHARACTER c)) - (\Proofreader.TestCorruption analyzer word wordList] - [COND - ((OR (EQ caps NIL) - (NOT (ALPHACHARP (CHCON1 temp))) - (AND (EQ caps (QUOTE FIRST)) - (NEQ tail word))) - (for c from (CHARCODE a) to (CHARCODE z) - do (COND - ((NEQ temp (CHARACTER c)) - (RPLACA tail (CHARACTER c)) - (\Proofreader.TestCorruption analyzer word wordList] - (COND - (periods (RPLACA tail (QUOTE %.)) - (\Proofreader.TestCorruption analyzer word wordList))) - (RPLACA tail temp)) - (SETQ wordList (SORT wordList)) - [for i on wordList do (while (STREQUAL (CAR i) - (CADR i)) - do (RPLACD i (CDDR i] - (RETURN wordList]) - -(Proofreader.NextWord - [LAMBDA (analyzer stream startPtr searchLength NWFn) (* jtm: " 6-Feb-87 15:29") - - (* * Scans the stream looking for a word, i.e. a sequence of alphabetic charqacters. If the file ptr is already in  - the middle of such a sequence, it backs up to the beginning of that sequence. The function applies NWFn to  - (stream start stop) for each such word.) - - - (SETFILEPTR stream (OR startPtr (SETQ startPtr 0))) - (bind char end endPtr word length start value quote period number (filePtr _(GETFILEPTR - stream)) - (EOFPtr _(GETEOFPTR stream)) first (SETQ endPtr (COND - (searchLength (IMIN EOFPtr (IPLUS startPtr - searchLength))) - (T EOFPtr))) - do (SETQ char (AND (ILESSP (GETFILEPTR stream) - endPtr) - (BIN stream))) - (COND - [(AND char (AND (NUMBERP char) - (ILESSP char 128) - (Analyzer.AlphaCharP char))) - [OR start (SETQ start (SUB1 (GETFILEPTR stream] - (COND - (number (* we have a number followed by some characters. - (e.g. 7th, 21st, etc.) Take in the last digit of the  - number.) - (add start -1) - (SETQ number NIL))) - (COND - (quote (COND - ((EQ quote T) (* don't make a list until you need to.) - (SETQ quote NIL))) - (push quote char))) - (COND - (period (COND - ((EQ period T) - (SETQ period NIL))) - (push period char] - ((AND start char (EQUAL char (CHARCODE '))) - (* if the quote is in the middle of a word, leave it  - in.) - (SETQ quote T)) - ((AND start char (EQUAL char (CHARCODE %.))) - (* look for e.g., i.e.) - (OR period (SETQ period T))) - (start (SETQ end (GETFILEPTR stream)) - (SETQ length (IDIFFERENCE end start)) - (AND char (add length -1)) (* back up to the last legal char.) - (COND - ((EQ quote T) (* delete final quotes) - (add length -1)) - ([OR (EQUAL quote (QUOTE (115))) - (EQUAL quote (QUOTE (83] (* delete 's) - (add length -2))) - (SETQ quote NIL) - (COND - ((EQ period T) (* delete final periods) - (add length -1))) - (SETQ period NIL) - (COND - ((AND (EQ length 1) - (EQ char (CHARCODE %)))) - (* letters used for outlines.) - (add length 1))) - [COND - [NWFn (SETQ value (APPLY* NWFn analyzer stream start length)) - (COND - ((EQ value T) - (RETURN (CONS start length))) - (value (RETURN value] - (T (RETURN (CONS start length] - (SETFILEPTR stream end) - (SETQ start NIL)) - ((AND char (NUMBERP char) - (IGEQ char 48) - (ILEQ char 57)) (* a number) - (SETQ number char)) - (T (SETQ number NIL))) - (OR char (RETURN]) -) -(DECLARE: EVAL@COMPILE - -(PUTPROPS Proofreader.Hash1 MACRO - ((X) - (IPLUS (LLSH (LOGAND X 2047) - 5) - (LRSH X 11)))) - -(PUTPROPS Proofreader.Hash2 MACRO - ((X) - (IPLUS (LLSH (LOGAND X 8191) - 3) - (LRSH X 13)))) - -(PUTPROPS \Proofreader.TestCorruption MACRO - [(analyzer word wordList) - (COND - ((Proofreader.Lookup analyzer word NIL NIL) - (push wordList (CONCATLIST word]) -) - -(RPAQ? Proofreader NIL) - -(RPAQ? Proofreader.AutoLoad NIL) - -(RPAQ? Proofreader.Lisp NIL) - - - -(* Proofreader.AutoLoad is a file or list of files to be loaded whenever a proofreader is -opened.) - -[Analyzer.Establish (SETQ Proofreader (Proofreader.New (QUOTE Proofreader] -(PUTPROPS PROOFREADER COPYRIGHT ("Xerox Corporation" 1985 1986 1987)) -(DECLARE: DONTCOPY - (FILEMAP (NIL (1007 10101 (Proofreader.New 1017 . 1378) (Proofreader.Open 1380 . 3320) ( -Proofreader.AddEntry 3322 . 6312) (Proofreader.Lookup 6314 . 9110) (Proofreader.AllForms 9112 . 10099) -) (10102 13915 (Proofreader.CharTable 10112 . 12273) (Proofreader.LookupBit 12275 . 13040) ( -Proofreader.SetBit 13042 . 13913)) (13916 21770 (Proofreader.Correct 13926 . 18270) ( -Proofreader.NextWord 18272 . 21768))))) -STOP diff --git a/lispusers/proofreader/PROOFREADER b/lispusers/proofreader/PROOFREADER new file mode 100644 index 000000000..1f108f34c --- /dev/null +++ b/lispusers/proofreader/PROOFREADER @@ -0,0 +1,577 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "22-Jul-2025 12:42:38"  +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>proofreader>PROOFREADER.;5 29801 + + :EDIT-BY rmk + + :CHANGES-TO (VARS PROOFREADERCOMS) + (FNS Proofreader.Open Proofreader.NextWord) + + :PREVIOUS-DATE "21-Jul-2025 23:13:43" +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>proofreader>PROOFREADER.;4) + + +(PRETTYCOMPRINT PROOFREADERCOMS) + +(RPAQQ PROOFREADERCOMS + [(FILES PROOFREADER-ANALYZER PROOFREADER-SPELLINGARRAY) + (FNS Proofreader.New Proofreader.Open Proofreader.AddEntry Proofreader.Lookup + Proofreader.AllForms) + (FNS Proofreader.CharTable Proofreader.LookupBit Proofreader.SetBit) + (FNS Proofreader.Correct Proofreader.NextWord) + (MACROS Proofreader.Hash1 Proofreader.Hash2 \Proofreader.TestCorruption) + (INITVARS Proofreader Proofreader.AutoLoad Proofreader.Lisp) + (* Proofreader.AutoLoad is a file or list of files to be loaded whenever a proofreader is + opened.) + (P (Analyzer.Establish (SETQ Proofreader (Proofreader.New 'Proofreader]) + +(FILESLOAD PROOFREADER-ANALYZER PROOFREADER-SPELLINGARRAY) +(DEFINEQ + +(Proofreader.New + [LAMBDA (name fileName) (* jtm%: "13-Oct-87 11:57") + (PROG [(analyzer (create Morphalyzer + analyzerName _ name + openFn _ (FUNCTION Proofreader.Open) + lookupFn _ (FUNCTION Proofreader.Lookup) + addEntryFn _ (FUNCTION Proofreader.AddEntry] + (RETURN analyzer]) + +(Proofreader.Open + [LAMBDA (analyzer stream) (* jtm%: " 6-Feb-87 15:24") + (COND + ((NULL (fetch (Morphalyzer index) of analyzer)) + [replace (Morphalyzer index) of analyzer + with (PROG [(file (Analyzer.Prop analyzer 'FileName] + [COND + ((AND (NULL SpellingArray) + (NULL file)) + (ERROR "No Spelling Array for" analyzer)) + ((NULL SpellingArray) + (COND + ((NULL stream) + (PROMPTPRINT "initializing Proofreader")) + (T (TEDIT.PROMPTPRINT stream "initializing Proofreader" T))) + (RESETLST + (PROG (LENGTH ALENGTH BLOCK STREAM (START 0) + (HEADERSIZE 6)) + [RESETSAVE (SETQ STREAM (OPENSTREAM file 'INPUT 'OLD)) + '(PROGN (CLOSEF OLDVALUE] + (SETQ LENGTH (IDIFFERENCE (GETFILEINFO file 'LENGTH) + (IPLUS HEADERSIZE 2))) + (for i from 1 to HEADERSIZE do (BIN STREAM)) + (* skip header) + (while (ILESSP START LENGTH) + do (SETQ ALENGTH (MIN 64000 (IDIFFERENCE LENGTH START))) + (SETQ BLOCK (\ALLOCBLOCK (LRSH (IPLUS 3 ALENGTH) + 2))) + (\BINS STREAM BLOCK 0 ALENGTH) + (add START ALENGTH) + (push SpellingArray (CONS START BLOCK))) + (SETQ SpellingArray (REVERSE SpellingArray))))] + (RETURN (CONS SpellingArray (Proofreader.CharTable] + (for file inside Proofreader.AutoLoad do (Analyzer.DefaultLoadWordList analyzer file]) + +(Proofreader.AddEntry + [LAMBDA (analyzer lemma entry dontRecord) (* jtm%: " 6-Feb-87 15:24") + + (* * adds "lemma" to the SpellingArray. This procedure is just like Lookup, only + it sets the bits rather than just reading them.) + + (PROG (char p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 hashArray + hashArray.CharTable start length) (* first save the word on a property + list.) + (COND + ((NULL dontRecord) + (Analyzer.PushProp analyzer 'WordList lemma))) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer)) + [COND + ((NULL entry) + (SETQ entry (Proofreader.AllForms lemma] + [COND + ((NULL hashArray) + (Proofreader.Open analyzer) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer] + (SETQ hashArray.CharTable (CDR hashArray)) + (SETQ hashArray (CAR hashArray)) + (SETQ hash1 953) + (SETQ hash2 63869) + (SETQ hash3 2441) + (SETQ hash4 62265) + (SETQ hash5 4079) + (SETQ hash6 60585) + (SETQ hash7 5807) + (SETQ p 359) + (Stream.Init lemma start length) + (while (SETQ char (Stream.NextChar lemma length start)) + do [COND + ((ALPHACHARP char) + (SETQ char (ELT hashArray.CharTable (IDIFFERENCE char 64] + (add p 1009) + (SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash2)) + p))) + [SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2 hash3) + char] + [SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4) + char] + (SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2 hash5)) + p))) + (SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash6)) + p))) + (SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2 hash7) + char) + p))) + [SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1 hash1) + char] + (SETQ hash1 x1) + (SETQ hash2 x2) + (SETQ hash3 x3) + (SETQ hash4 x4) + (SETQ hash5 x5) + (SETQ hash6 x6) + (SETQ hash7 x7)) + + (* * set the bits.) + + (Proofreader.SetBit hash1 hash7 hashArray) + (Proofreader.SetBit hash2 hash6 hashArray) + (Proofreader.SetBit hash3 hash5 hashArray) + (Proofreader.SetBit hash4 hash4 hashArray) + (Proofreader.SetBit hash5 hash3 hashArray) + (Proofreader.SetBit hash6 hash2 hashArray) + (Proofreader.SetBit hash7 hash1 hashArray) + (RETURN lemma]) + +(Proofreader.Lookup + [LAMBDA (analyzer stream start length) (* jtm%: " 6-Feb-87 15:25") + + (* * hashes the string into the array using a probabalistic technique. + This may produce a false positive.) + + (PROG (char word p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 hashArray + hashArray.CharTable) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer)) + [COND + ((NULL hashArray) + (Proofreader.Open analyzer) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer] + (SETQ hashArray.CharTable (CDR hashArray)) + (SETQ hashArray (CAR hashArray)) + (SETQ hash1 953) + (SETQ hash2 63869) + (SETQ hash3 2441) + (SETQ hash4 62265) + (SETQ hash5 4079) + (SETQ hash6 60585) + (SETQ hash7 5807) + (SETQ p 359) + (Stream.Init stream start length) + (while (SETQ char (Stream.NextChar stream length start)) + do [COND + ((IGREATERP char 255) + (SETQ char (IMOD char 256] + [COND + ((ALPHACHARP char) + (SETQ char (ELT hashArray.CharTable (IDIFFERENCE char 64] + (add p 1009) + (SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash2)) + p))) + [SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2 hash3) + char] + [SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4) + char] + (SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2 hash5)) + p))) + (SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash6)) + p))) + (SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2 hash7) + char) + p))) + [SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1 hash1) + char] + (SETQ hash1 x1) + (SETQ hash2 x2) + (SETQ hash3 x3) + (SETQ hash4 x4) + (SETQ hash5 x5) + (SETQ hash6 x6) + (SETQ hash7 x7)) + (COND + ((AND (Proofreader.LookupBit hash1 hash7 hashArray) + (Proofreader.LookupBit hash2 hash6 hashArray) + (Proofreader.LookupBit hash3 hash5 hashArray) + (Proofreader.LookupBit hash4 hash4 hashArray) + (Proofreader.LookupBit hash5 hash3 hashArray) + (Proofreader.LookupBit hash6 hash2 hashArray) + (Proofreader.LookupBit hash7 hash1 hashArray)) + (RETURN T]) + +(Proofreader.AllForms + [LAMBDA (lemma) (* jtm%: " 6-Feb-87 15:25") + + (* * ask the user for the forms to fill out this word.) + + (PROG (forms form newForms menuPos) + (SETQ forms (LIST 'NOUN 'VERB 'ADJ (English.Suffix lemma "s") + (English.Suffix lemma "s") + (English.Suffix lemma "er") + " " + (English.Suffix lemma "ed") + (English.Suffix lemma "est") + " " + (English.Suffix lemma "ing") + " " " " '*OTHER*)) + (while [SETQ form + (MENU (create MENU + TITLE _ "parts of speech" + CENTERFLG _ T + ITEMS _ forms + MENUCOLUMNS _ 3 + CHANGEOFFSETFLG _ T + MENUPOSITION _ (COND + (menuPos) + (T (GETMOUSESTATE) + (SETQ menuPos (CONS LASTMOUSEX LASTMOUSEY] + do (pushnew newForms form)) + (RETURN newForms]) +) +(DEFINEQ + +(Proofreader.CharTable + [LAMBDA NIL (* jtm%: " 6-Feb-87 15:27") + + (* * comment) + + (PROG (SpellingArray.CharTable) + (SETQ SpellingArray.CharTable (ARRAY 58)) + (for i in '(0 32) do (SETA SpellingArray.CharTable (IPLUS i 1) + 65325) + (SETA SpellingArray.CharTable (IPLUS i 2) + 65204) + (SETA SpellingArray.CharTable (IPLUS i 3) + 449) + (SETA SpellingArray.CharTable (IPLUS i 4) + 588) + (SETA SpellingArray.CharTable (IPLUS i 5) + 7102) + (SETA SpellingArray.CharTable (IPLUS i 6) + 64682) + (SETA SpellingArray.CharTable (IPLUS i 7) + 64545) + (SETA SpellingArray.CharTable (IPLUS i 8) + 64418) + (SETA SpellingArray.CharTable (IPLUS i 9) + 1278) + (SETA SpellingArray.CharTable (IPLUS i 10) + 1433) + (SETA SpellingArray.CharTable (IPLUS i 11) + 63968) + (SETA SpellingArray.CharTable (IPLUS i 12) + 63827) + (SETA SpellingArray.CharTable (IPLUS i 13) + 1874) + (SETA SpellingArray.CharTable (IPLUS i 14) + 2027) + (SETA SpellingArray.CharTable (IPLUS i 15) + 2180) + (SETA SpellingArray.CharTable (IPLUS i 16) + 63195) + (SETA SpellingArray.CharTable (IPLUS i 17) + 63058) + (SETA SpellingArray.CharTable (IPLUS i 18) + 62865) + (SETA SpellingArray.CharTable (IPLUS i 19) + 2798) + (SETA SpellingArray.CharTable (IPLUS i 20) + 2963) + (SETA SpellingArray.CharTable (IPLUS i 21) + 62372) + (SETA SpellingArray.CharTable (IPLUS i 22) + 62216) + (SETA SpellingArray.CharTable (IPLUS i 23) + 62067) + (SETA SpellingArray.CharTable (IPLUS i 24) + 3624) + (SETA SpellingArray.CharTable (IPLUS i 25) + 3793) + (SETA SpellingArray.CharTable (IPLUS i 26) + 3944)) + (RETURN SpellingArray.CharTable]) + +(Proofreader.LookupBit + [LAMBDA (row column SpellingArray) (* jtm%: " 6-Feb-87 15:27") + + (* * There are 4096 bits per row, but only 4093 of them are used.) + + (PROG (byte (startByte 0)) + (SETQ row (IMOD row 199)) + (SETQ column (IMOD column 4093)) + (SETQ byte (IPLUS (LLSH row 9) + (LRSH column 3))) + (for block in SpellingArray do (COND + ((ILESSP byte (CAR block)) + (SETQ byte (\GETBASEBYTE (CDR block) + (IDIFFERENCE byte startByte))) + (RETURN))) + (SETQ startByte (CAR block))) + (RETURN (BITTEST byte (MASK.1'S (IDIFFERENCE 7 (LOGAND column 7)) + 1]) + +(Proofreader.SetBit + [LAMBDA (row column SpellingArray) (* jtm%: " 6-Feb-87 15:28") + + (* * There are 4096 bits per row, but only 4093 of them are used.) + + (PROG (address (startByte 0)) + (SETQ row (IMOD row 199)) + (SETQ column (IMOD column 4093)) + (SETQ address (IPLUS (LLSH row 9) + (LRSH column 3))) + (for block byte in SpellingArray do (COND + ((ILESSP address (CAR block)) + (SETQ byte (\GETBASEBYTE (CDR block) + (IDIFFERENCE address startByte))) + (SETQ byte (BITSET byte + (MASK.1'S (IDIFFERENCE + 7 + (LOGAND column 7)) + 1))) + (\PUTBASEBYTE (CDR block) + (IDIFFERENCE address startByte) + byte) + (RETURN))) + (SETQ startByte (CAR block]) +) +(DEFINEQ + +(Proofreader.Correct + [LAMBDA (analyzer stream start length) (* jtm%: " 6-Feb-87 15:28") + + (* * returns a list of possible spelling corrections for the given word.) + + (PROG (form word wordList caps periods) + [COND + ((NOT (LISTP stream)) + (SETFILEPTR stream start) + (SETQ word (for i from 1 to length collect (READC stream] + (SETQ caps (Analyzer.Capitalization word)) + (SETQ periods (FMEMB '%. word)) + + (* * first try transpositions) + + (for tail temp on word while (CDR tail) do (SETQ temp (CAR tail)) + (RPLACA tail (CADR tail)) + (RPLACA (CDR tail) + temp) + (COND + ((AND (EQ caps 'FIRST) + (EQ tail word)) + (* don't transpose the first letters + of a capitalized word.) + NIL) + (T (\Proofreader.TestCorruption analyzer word + wordList))) + (RPLACA (CDR tail) + (CAR tail)) + (RPLACA tail temp)) + + (* * next try deletions) + + (COND + ((CDR word) + (\Proofreader.TestCorruption analyzer (CDR word) + wordList))) + (for tail temp on word while (CDR tail) do (SETQ temp (CDR tail)) + (RPLACD tail (CDDR tail)) + (\Proofreader.TestCorruption analyzer word + wordList) + (RPLACD tail temp)) + + (* * prepend a character.) + + (SETQ word (CONS 'A word)) + (SELECTQ caps + (FIRST (* don't prepend a character before a + capitalized word.) + NIL) + (ALL (* prepend a capital letter.) + (for c from (CHARCODE A) to (CHARCODE Z) do (RPLACA word (CHARACTER c)) + (\Proofreader.TestCorruption analyzer + word wordList))) + (for c from (CHARCODE a) to (CHARCODE z) do (RPLACA word (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word + wordList))) + (SETQ word (CDR word)) + + (* * insert characters.) + + (for tail on word do (RPLACD tail (CONS 'A (CDR tail))) + [COND + ((EQ caps 'ALL) + (for c from (CHARCODE A) to (CHARCODE Z) + do (RPLACA (CDR tail) + (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList))) + (T (for c from (CHARCODE a) to (CHARCODE z) + do (RPLACA (CDR tail) + (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList] + (COND + (periods (RPLACA (CDR tail) + '%.) + (\Proofreader.TestCorruption analyzer word wordList))) + (RPLACD tail (CDDR tail))) + + (* * replace characters) + + (for tail temp on word do (SETQ temp (CAR tail)) + [COND + ((OR (EQ caps 'ALL) + (AND (EQ caps 'FIRST) + (EQ tail word))) + (for c from (CHARCODE A) to (CHARCODE Z) + do (COND + ((NEQ temp (CHARACTER c)) + (RPLACA tail (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList + ] + [COND + ((OR (EQ caps NIL) + (NOT (ALPHACHARP (CHCON1 temp))) + (AND (EQ caps 'FIRST) + (NEQ tail word))) + (for c from (CHARCODE a) to (CHARCODE z) + do (COND + ((NEQ temp (CHARACTER c)) + (RPLACA tail (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList + ] + (COND + (periods (RPLACA tail '%.) + (\Proofreader.TestCorruption analyzer word wordList))) + (RPLACA tail temp)) + (SETQ wordList (SORT wordList)) + [for i on wordList do (while (STREQUAL (CAR i) + (CADR i)) do (RPLACD i (CDDR i] + (RETURN wordList]) + +(Proofreader.NextWord + [LAMBDA (analyzer stream startPtr searchLength NWFn) (* jtm%: " 6-Feb-87 15:29") + + (* * Scans the stream looking for a word, i.e. + a sequence of alphabetic charqacters. If the file ptr is already in the middle of + such a sequence, it backs up to the beginning of that sequence. + The function applies NWFn to (stream start stop) for each such word.) + + (SETFILEPTR stream (OR startPtr (SETQ startPtr 0))) + (bind char end endPtr word length start value quote period number (filePtr _ (GETFILEPTR stream)) + (EOFPtr _ (GETEOFPTR stream)) first (SETQ endPtr (COND + (searchLength (IMIN EOFPtr + (IPLUS startPtr + searchLength + ))) + (T EOFPtr))) + do (SETQ char (AND (ILESSP (GETFILEPTR stream) + endPtr) + (BIN stream))) + (COND + [(AND char (AND (NUMBERP char) + (ILESSP char 128) + (Analyzer.AlphaCharP char))) + [OR start (SETQ start (SUB1 (GETFILEPTR stream] + (COND + (number + + (* we have a number followed by some characters. + (e.g. 7th, 21st, etc.) Take in the last digit of the number.) + + (add start -1) + (SETQ number NIL))) + (COND + (quote (COND + ((EQ quote T) (* don't make a list until you need + to.) + (SETQ quote NIL))) + (push quote char))) + (COND + (period (COND + ((EQ period T) + (SETQ period NIL))) + (push period char] + ((AND start char (EQUAL char (CHARCODE %'))) (* if the quote is in the middle of a + word, leave it in.) + (SETQ quote T)) + ((AND start char (EQUAL char (CHARCODE %.))) (* look for e.g., i.e.) + (OR period (SETQ period T))) + (start (SETQ end (GETFILEPTR stream)) + (SETQ length (IDIFFERENCE end start)) + (AND char (add length -1)) (* back up to the last legal char.) + (COND + ((EQ quote T) (* delete final quotes) + (add length -1)) + ([OR (EQUAL quote '(115)) + (EQUAL quote '(83] (* delete %'s) + (add length -2))) + (SETQ quote NIL) + (COND + ((EQ period T) (* delete final periods) + (add length -1))) + (SETQ period NIL) + (COND + ((AND (EQ length 1) + (EQ char (CHARCODE %)))) (* letters used for outlines.) + (add length 1))) + [COND + [NWFn (SETQ value (APPLY* NWFn analyzer stream start length)) + (COND + ((EQ value T) + (RETURN (CONS start length))) + (value (RETURN value] + (T (RETURN (CONS start length] + (SETFILEPTR stream end) + (SETQ start NIL)) + ((AND char (NUMBERP char) + (IGEQ char 48) + (ILEQ char 57)) (* a number) + (SETQ number char)) + (T (SETQ number NIL))) + (OR char (RETURN]) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS Proofreader.Hash1 MACRO ((X) + (IPLUS (LLSH (LOGAND X 2047) + 5) + (LRSH X 11)))) + +(PUTPROPS Proofreader.Hash2 MACRO ((X) + (IPLUS (LLSH (LOGAND X 8191) + 3) + (LRSH X 13)))) + +(PUTPROPS \Proofreader.TestCorruption MACRO [(analyzer word wordList) + (COND + ((Proofreader.Lookup analyzer word NIL NIL) + (push wordList (CONCATLIST word]) +) + +(RPAQ? Proofreader NIL) + +(RPAQ? Proofreader.AutoLoad NIL) + +(RPAQ? Proofreader.Lisp NIL) + + + +(* Proofreader.AutoLoad is a file or list of files to be loaded whenever a proofreader is opened.) + + +[Analyzer.Establish (SETQ Proofreader (Proofreader.New 'Proofreader] +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1259 11994 (Proofreader.New 1269 . 1711) (Proofreader.Open 1713 . 4011) ( +Proofreader.AddEntry 4013 . 7415) (Proofreader.Lookup 7417 . 10627) (Proofreader.AllForms 10629 . +11992)) (11995 17822 (Proofreader.CharTable 12005 . 15342) (Proofreader.LookupBit 15344 . 16294) ( +Proofreader.SetBit 16296 . 17820)) (17823 28716 (Proofreader.Correct 17833 . 24399) ( +Proofreader.NextWord 24401 . 28714))))) +STOP diff --git a/lispusers/ANALYZER b/lispusers/proofreader/PROOFREADER-ANALYZER similarity index 54% rename from lispusers/ANALYZER rename to lispusers/proofreader/PROOFREADER-ANALYZER index 789f19944..13968a612 100644 --- a/lispusers/ANALYZER +++ b/lispusers/proofreader/PROOFREADER-ANALYZER @@ -1,18 +1,18 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 9-Mar-89 15:24:58" {ERINYES}MEDLEY>ANALYZER.;9 86708 - changes to%: (FNS Analyzer.ReadWordList) +(FILECREATED "21-Jul-2025 23:21:18" {WMEDLEY}proofreader>PROOFREADER-ANALYZER.;3 82253 - previous date%: "13-Jan-89 15:50:22" {ERINYES}MEDLEY>ANALYZER.;8) + :EDIT-BY rmk + :CHANGES-TO (FNS TEdit.ProofreadMenu TEdit.Correct) + + :PREVIOUS-DATE "21-Jul-2025 23:16:25" {WMEDLEY}proofreader>PROOFREADER-ANALYZER.;2 +) -(* " -Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights reserved. -") -(PRETTYCOMPRINT ANALYZERCOMS) +(PRETTYCOMPRINT PROOFREADER-ANALYZERCOMS) -(RPAQQ ANALYZERCOMS +(RPAQQ PROOFREADER-ANALYZERCOMS [(COMS (* ;;; "THE ANALYZER CLASS") @@ -32,7 +32,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res Analyzer.DefaultAnalyze Analyzer.DefaultProofread) (* ;; - "Functions implementing the default case for various methods of the analyzer class.") + "Functions implementing the default case for various methods of the analyzer class.") (FNS Analyzer.DefaultLoadWordList Analyzer.DefaultStoreWordList Analyzer.ReadWordList Analyzer.WriteWordList CREATEWORDLISTRDTBL) @@ -105,19 +105,18 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DECLARE%: EVAL@COMPILE -(DATATYPE Morphalyzer (analyzerName grammar index analyzerProps openFn closeFn proofreadFn - analyzeFn lookupFn correctionsFn generateFn conjugateFn findWordFn - addEntryFn) - openFn _ (FUNCTION NILL) - closeFn _ (FUNCTION NILL) - proofreadFn _ (FUNCTION Analyzer.DefaultProofread) - analyzeFn _ (FUNCTION Analyzer.DefaultAnalyze) - lookupFn _ (FUNCTION NILL) - correctionsFn _ (FUNCTION Analyzer.DefaultCorrections) - generateFn _ (FUNCTION NILL) - conjugateFn _ (FUNCTION NILL) - findWordFn _ (FUNCTION NILL) - addEntryFn _ (FUNCTION Analyzer.DefaultAddEntry)) +(DATATYPE Morphalyzer (analyzerName grammar index analyzerProps openFn closeFn proofreadFn analyzeFn + lookupFn correctionsFn generateFn conjugateFn findWordFn addEntryFn) + openFn _ (FUNCTION NILL) + closeFn _ (FUNCTION NILL) + proofreadFn _ (FUNCTION Analyzer.DefaultProofread) + analyzeFn _ (FUNCTION Analyzer.DefaultAnalyze) + lookupFn _ (FUNCTION NILL) + correctionsFn _ (FUNCTION Analyzer.DefaultCorrections) + generateFn _ (FUNCTION NILL) + conjugateFn _ (FUNCTION NILL) + findWordFn _ (FUNCTION NILL) + addEntryFn _ (FUNCTION Analyzer.DefaultAddEntry)) ) (/DECLAREDATATYPE 'Morphalyzer @@ -146,74 +145,67 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DECLARE%: EVAL@COMPILE (PUTPROPS Analyzer.Open MACRO ((analyzer) - (APPLY* (fetch (Morphalyzer openFn) of analyzer) - analyzer))) + (APPLY* (fetch (Morphalyzer openFn) of analyzer) + analyzer))) (PUTPROPS Analyzer.Close MACRO ((analyzer) - (APPLY* (fetch (Morphalyzer closeFn) of analyzer) - analyzer))) + (APPLY* (fetch (Morphalyzer closeFn) of analyzer) + analyzer))) (PUTPROPS Analyzer.Corrections MACRO ((analyzer stream start length) (* * returns a list of possible corrections for the string starting at "start" - that is "length" characters long.) + that is "length" characters long.) - (APPLY* (fetch (Morphalyzer correctionsFn) - of analyzer) - analyzer stream start length))) + (APPLY* (fetch (Morphalyzer correctionsFn) of analyzer) + analyzer stream start length))) (PUTPROPS Analyzer.Proofread MACRO ((analyzer stream start length prFn) (* * The user interface to Analyzer.Analyze.) - (APPLY* (fetch (Morphalyzer proofreadFn) of - analyzer) - analyzer stream start length prFn))) + (APPLY* (fetch (Morphalyzer proofreadFn) of analyzer) + analyzer stream start length prFn))) (PUTPROPS Analyzer.Analyze MACRO ((analyzer stream start length analFn allowWildCards) (* * break up the stream into legal lexical items. - calls analFn (analyzer stream start len entries) on each item, where "entries" - is the analysis of that item. If "entries" is NIL, then the item could not be - analyzed.) + calls analFn (analyzer stream start len entries) on each item, where "entries" is + the analysis of that item. If "entries" is NIL, then the item could not be + analyzed.) - (APPLY* (fetch (Morphalyzer analyzeFn) of analyzer) - analyzer stream start length analFn allowWildCards))) + (APPLY* (fetch (Morphalyzer analyzeFn) of analyzer) + analyzer stream start length analFn allowWildCards))) (PUTPROPS Analyzer.Lookup MACRO ((analyzer stream start length) (* * Look up the substring of stream between start and length in dict. - "stream" can be a stream, a string, or a list of characters.) + "stream" can be a stream, a string, or a list of characters.) - (APPLY* (fetch (Morphalyzer lookupFn) of analyzer) - analyzer stream start length))) + (APPLY* (fetch (Morphalyzer lookupFn) of analyzer) + analyzer stream start length))) (PUTPROPS Analyzer.FindWord MACRO ((analyzer word stream start length) - (APPLY* (fetch (Morphalyzer findWordFn) of - analyzer - ) - analyzer word stream start length))) + (APPLY* (fetch (Morphalyzer findWordFn) of analyzer) + analyzer word stream start length))) (PUTPROPS Analyzer.AddEntry MACRO ((analyzer lemma entry dontRecord) (* * add lemma to the dictionary with entry "entry" %. - If dontRecord is non-NIL, don't worry about keeping track of this word for the - word list.) + If dontRecord is non-NIL, don't worry about keeping track of this word for the + word list.) - (APPLY* (fetch (Morphalyzer addEntryFn) of - analyzer - ) - analyzer lemma entry dontRecord))) + (APPLY* (fetch (Morphalyzer addEntryFn) of analyzer) + analyzer lemma entry dontRecord))) (PUTPROPS Dict.DisplayEntry MACRO ((dict entry newwindowflg) - (APPLY* (OR [COND - ((type? Dict dict) - (Dict.Prop dict 'DISPLAYENTRYFN)) - ((type? INVERTEDDICT dict) - (InvertedDict.Prop dict - 'DISPLAYENTRYFN] - 'NILL) - dict entry newwindowflg))) + (APPLY* (OR [COND + ((type? Dict dict) + (Dict.Prop dict 'DISPLAYENTRYFN)) + ((type? INVERTEDDICT dict) + (InvertedDict.Prop dict 'DISPLAYENTRYFN] + 'NILL) + dict entry newwindowflg))) ) @@ -223,7 +215,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DEFINEQ (AnalyzerFromName - [LAMBDA (dictName remoteName) (* ; "Edited 6-Oct-88 09:56 by jtm:") + [LAMBDA (dictName remoteName) (* ; "Edited 6-Oct-88 09:56 by jtm:") (* * find the analyzer corresponding to the dictionary.) @@ -232,14 +224,11 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res ((NULL dictName) (SETQ analyzer (CAR Analyzer.List))) [(for i in Analyzer.List do (COND - ([AND (EQ dictName (fetch (Morphalyzer - analyzerName) - of i)) - (EQ remoteName (Analyzer.Prop - i - 'RemoteDict] - (SETQ analyzer i) - (RETURN T] + ([AND (EQ dictName (fetch (Morphalyzer analyzerName) + of i)) + (EQ remoteName (Analyzer.Prop i 'RemoteDict] + (SETQ analyzer i) + (RETURN T] ((SETQ COLONPOS (STRPOS ":" dictName)) (SETQ analyzer (AnalyzerFromName (SUBATOM dictName 1 (SUB1 COLONPOS)) (SUBATOM dictName (IPLUS COLONPOS 2) @@ -247,7 +236,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (RETURN analyzer]) (Analyzer.CountWords - [LAMBDA (analyzer stream start length) (* jtm%: "13-Nov-86 13:32") + [LAMBDA (analyzer stream start length) (* jtm%: "13-Nov-86 13:32") (LET [(n 0) (FN (Analyzer.Prop analyzer 'CountWords] (COND @@ -260,7 +249,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res n]) (Analyzer.DefaultCorrections - [LAMBDA (analyzer stream start length) (* jtm%: " 7-Apr-87 08:23") + [LAMBDA (analyzer stream start length) (* jtm%: " 7-Apr-87 08:23") (* * returns a list of possible spelling corrections for the given word.) @@ -270,28 +259,28 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (SETFILEPTR stream start) (SETQ word (for i from 1 to length collect (BIN stream] ((STRINGP stream) - (SETQ word (for i from 1 to (NCHARS stream) collect (NTHCHARCODE stream - i] + (SETQ word (for i from 1 to (NCHARS stream) collect (NTHCHARCODE stream i] (SETQ caps (Analyzer.Capitalization word)) (SETQ periods (FMEMB (CHARCODE %.) word)) (* * first try transpositions) - (for tail temp on word while (CDR tail) - do (SETQ temp (CAR tail)) - (RPLACA tail (CADR tail)) - (RPLACA (CDR tail) - temp) - (COND - ((AND (EQ caps 'FIRST) - (EQ tail word)) (* don't transpose the first letters - of a capitalized word.) - NIL) - (T (\Analyzer.TestCorruption analyzer word wordList userDict))) - (RPLACA (CDR tail) - (CAR tail)) - (RPLACA tail temp)) + (for tail temp on word while (CDR tail) do (SETQ temp (CAR tail)) + (RPLACA tail (CADR tail)) + (RPLACA (CDR tail) + temp) + (COND + ((AND (EQ caps 'FIRST) + (EQ tail word)) + (* don't transpose the first letters + of a capitalized word.) + NIL) + (T (\Analyzer.TestCorruption analyzer word + wordList userDict))) + (RPLACA (CDR tail) + (CAR tail)) + (RPLACA tail temp)) (* * next try deletions) @@ -300,132 +289,122 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (\Analyzer.TestCorruption analyzer (CDR word) wordList userDict))) (for tail temp on word while (CDR tail) do (SETQ temp (CDR tail)) - (RPLACD tail (CDDR tail)) - (\Analyzer.TestCorruption - analyzer word wordList - userDict) - (RPLACD tail temp)) + (RPLACD tail (CDDR tail)) + (\Analyzer.TestCorruption analyzer word wordList + userDict) + (RPLACD tail temp)) (* * prepend a character.) (SETQ word (CONS (CHARCODE A) word)) (SELECTQ caps - (FIRST (* don't prepend a character before - a capitalized word.) + (FIRST (* don't prepend a character before a + capitalized word.) NIL) (ALL (* prepend a capital letter.) - (for c from (CHARCODE A) to (CHARCODE Z) - do (RPLACA word c) - (\Analyzer.TestCorruption analyzer word wordList userDict))) - (for c from (CHARCODE a) to (CHARCODE z) - do (RPLACA word c) - (\Analyzer.TestCorruption analyzer word wordList userDict))) + (for c from (CHARCODE A) to (CHARCODE Z) do (RPLACA word c) + (\Analyzer.TestCorruption analyzer + word wordList userDict))) + (for c from (CHARCODE a) to (CHARCODE z) do (RPLACA word c) + (\Analyzer.TestCorruption analyzer word + wordList userDict))) (SETQ word (CDR word)) (* * insert characters.) (for tail on word do (RPLACD tail (CONS (CHARCODE A) - (CDR tail))) - [COND - ((EQ caps 'ALL) - (for c from (CHARCODE A) - to (CHARCODE Z) - do (RPLACA (CDR tail) - c) - (\Analyzer.TestCorruption analyzer word - wordList userDict))) - (T (for c from (CHARCODE a) - to (CHARCODE z) - do (RPLACA (CDR tail) - c) - (\Analyzer.TestCorruption analyzer word - wordList userDict] - (COND - (periods (RPLACA (CDR tail) - (CHARCODE %.)) - (\Analyzer.TestCorruption analyzer word wordList - userDict))) - (RPLACD tail (CDDR tail))) + (CDR tail))) + [COND + ((EQ caps 'ALL) + (for c from (CHARCODE A) to (CHARCODE Z) + do (RPLACA (CDR tail) + c) + (\Analyzer.TestCorruption analyzer word wordList userDict))) + (T (for c from (CHARCODE a) to (CHARCODE z) + do (RPLACA (CDR tail) + c) + (\Analyzer.TestCorruption analyzer word wordList userDict] + (COND + (periods (RPLACA (CDR tail) + (CHARCODE %.)) + (\Analyzer.TestCorruption analyzer word wordList userDict))) + (RPLACD tail (CDDR tail))) (* * replace characters) (for tail temp on word do (SETQ temp (CAR tail)) - [COND - ((OR (EQ caps 'ALL) - (AND (EQ caps 'FIRST) - (EQ tail word))) - (for c from (CHARCODE A) - to (CHARCODE Z) - do (COND - ((NEQ temp c) - (RPLACA tail c) - (\Analyzer.TestCorruption analyzer - word wordList userDict] - [COND - ((OR (EQ caps NIL) - (NOT (ALPHACHARP (CHCON1 temp))) - (AND (EQ caps 'FIRST) - (NEQ tail word))) - (for c from (CHARCODE a) - to (CHARCODE z) - do (COND - ((NEQ temp c) - (RPLACA tail c) - (\Analyzer.TestCorruption analyzer - word wordList userDict] - (COND - (periods (RPLACA tail (CHARCODE %.)) - (\Analyzer.TestCorruption analyzer word - wordList userDict))) - (RPLACA tail temp)) + [COND + ((OR (EQ caps 'ALL) + (AND (EQ caps 'FIRST) + (EQ tail word))) + (for c from (CHARCODE A) to (CHARCODE Z) + do (COND + ((NEQ temp c) + (RPLACA tail c) + (\Analyzer.TestCorruption analyzer word wordList + userDict] + [COND + ((OR (EQ caps NIL) + (NOT (ALPHACHARP (CHCON1 temp))) + (AND (EQ caps 'FIRST) + (NEQ tail word))) + (for c from (CHARCODE a) to (CHARCODE z) + do (COND + ((NEQ temp c) + (RPLACA tail c) + (\Analyzer.TestCorruption analyzer word wordList + userDict] + (COND + (periods (RPLACA tail (CHARCODE %.)) + (\Analyzer.TestCorruption analyzer word wordList + userDict))) + (RPLACA tail temp)) (SETQ wordList (SORT wordList)) [for i on wordList do (while (STREQUAL (CAR i) - (CADR i)) - do (RPLACD i (CDDR i] + (CADR i)) do (RPLACD i (CDDR i] (RETURN wordList]) (Analyzer.DefaultNextWord - [LAMBDA (analyzer stream startPtr searchLength NWFn) (* jtm%: "29-Oct-85 15:23") + [LAMBDA (analyzer stream startPtr searchLength NWFn) (* jtm%: "29-Oct-85 15:23") (* * Scans the stream looking for a word, i.e. - a sequence of alphabetic charqacters. If the file ptr is already in the middle - of such a sequence, it backs up to the beginning of that sequence. - The function applies NWFn to (stream start stop) for each such word.) + a sequence of alphabetic charqacters. If the file ptr is already in the middle of + such a sequence, it backs up to the beginning of that sequence. + The function applies NWFn to (stream start stop) for each such word.) (SETFILEPTR stream (OR startPtr (SETQ startPtr 0))) (bind char end endPtr word length start value quote (filePtr _ (GETFILEPTR stream)) - (EOFPtr _ (GETEOFPTR stream)) first (SETQ endPtr (COND - (searchLength (IPLUS startPtr - searchLength) - ) - (T EOFPtr))) - (OR (ILEQ endPtr EOFPtr) - (SETQ endPtr EOFPtr)) + (EOFPtr _ (GETEOFPTR stream)) first (SETQ endPtr (COND + (searchLength (IPLUS startPtr + searchLength)) + (T EOFPtr))) + (OR (ILEQ endPtr EOFPtr) + (SETQ endPtr EOFPtr)) do (SETQ char (AND (ILESSP (GETFILEPTR stream) - endPtr) - (BIN stream))) - (COND - [(AND char (AND (NUMBERP char) - (ILESSP char 128) - (Analyzer.AlphaCharP char))) - (OR start (SETQ start (SUB1 (GETFILEPTR stream] - (start (SETQ end (GETFILEPTR stream)) - (SETQ length (IDIFFERENCE end start)) - (AND char (add length -1)) (* back up to the last legal char.) - [COND - (NWFn (SETQ value (APPLY* NWFn analyzer stream start length] - (COND - ((OR (NULL NWFn) - (EQ value T)) - (RETURN (CONS start length))) - (value (RETURN value))) - (SETFILEPTR stream end) - (SETQ start NIL))) - (OR char (RETURN]) + endPtr) + (BIN stream))) + (COND + [(AND char (AND (NUMBERP char) + (ILESSP char 128) + (Analyzer.AlphaCharP char))) + (OR start (SETQ start (SUB1 (GETFILEPTR stream] + (start (SETQ end (GETFILEPTR stream)) + (SETQ length (IDIFFERENCE end start)) + (AND char (add length -1)) (* back up to the last legal char.) + [COND + (NWFn (SETQ value (APPLY* NWFn analyzer stream start length] + (COND + ((OR (NULL NWFn) + (EQ value T)) + (RETURN (CONS start length))) + (value (RETURN value))) + (SETFILEPTR stream end) + (SETQ start NIL))) + (OR char (RETURN]) (Analyzer.Name - [LAMBDA (analyzer) (* jtm%: "13-Oct-87 10:44") + [LAMBDA (analyzer) (* jtm%: "13-Oct-87 10:44") (COND [(Analyzer.Prop analyzer 'RemoteDict) (MKATOM (CONCAT (fetch (Morphalyzer analyzerName) of analyzer) @@ -434,7 +413,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (T (fetch (Morphalyzer analyzerName) of analyzer]) (Analyzer.DefaultAddEntry - [LAMBDA (analyzer lemma entry dontRecord errorStream) (* jtm%: " 7-Apr-87 07:57") + [LAMBDA (analyzer lemma entry dontRecord errorStream) (* jtm%: " 7-Apr-87 07:57") (LET [(userDict (Analyzer.Prop analyzer 'UserDict] (COND ((NULL userDict) @@ -451,116 +430,118 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (* ; "Edited 23-Nov-88 08:17 by jtm:") (* * Scans the stream looking for a word, i.e. - a sequence of alphabetic charqacters. If the file ptr is already in the middle - of such a sequence, it backs up to the beginning of that sequence. - The function applies NWFn to (stream start stop) for each such word.) + a sequence of alphabetic charqacters. If the file ptr is already in the middle of + such a sequence, it backs up to the beginning of that sequence. + The function applies NWFn to (stream start stop) for each such word.) [COND ((STRINGP stream) (SETQ stream (OPENSTRINGSTREAM stream] (SETFILEPTR stream (OR startPtr (SETQ startPtr 0))) - (bind char end endPtr length start lookup number initialQuote seprs - (userDict _ (Analyzer.Prop analyzer 'UserDict)) - [optSeprCodes _ (OR (Analyzer.Prop analyzer 'OPT-SEPR-CODES) - '(39 46 45 47] - (addAlphaCharCodes _ (Analyzer.Prop analyzer 'ADD-ALPHA-CHAR-CODES)) - (word _ (ALLOCSTRING 100 32)) - (i _ startPtr) first (DECLARE (LOCALVARS . T)) - [SETQ endPtr (COND - (searchLength (IMIN (GETEOFPTR stream) - (IPLUS startPtr searchLength))) - (T (GETEOFPTR stream] + (bind char end endPtr length start lookup number initialQuote seprs (userDict _ + (Analyzer.Prop + analyzer + 'UserDict)) + [optSeprCodes _ (OR (Analyzer.Prop analyzer 'OPT-SEPR-CODES) + '(39 46 45 47] + (addAlphaCharCodes _ (Analyzer.Prop analyzer 'ADD-ALPHA-CHAR-CODES)) + (word _ (ALLOCSTRING 100 32)) + (i _ startPtr) first (DECLARE (LOCALVARS . T)) + [SETQ endPtr (COND + (searchLength (IMIN (GETEOFPTR stream) + (IPLUS startPtr searchLength))) + (T (GETEOFPTR stream] do (SETQ char (AND (add i 1) - (ILEQ i endPtr) - (BIN stream))) - (COND - ((AND start (NUMBERP char) - (ILESSP char 128)) - (RPLCHARCODE word (IDIFFERENCE i start) - char))) - [COND - [[AND char (OR (AND (NUMBERP char) - (ILESSP char 128) - (Analyzer.AlphaCharP char)) - (FMEMB char addAlphaCharCodes) - (AND allowWildCards (EQ char (CONSTANT (CHARCODE *] - (COND - ((NULL start) - [COND - (number (SETQ start (IDIFFERENCE i 2)) + (ILEQ i endPtr) + (BIN stream))) + (COND + ((AND start (NUMBERP char) + (ILESSP char 128)) + (RPLCHARCODE word (IDIFFERENCE i start) + char))) + [COND + [[AND char (OR (AND (NUMBERP char) + (ILESSP char 128) + (Analyzer.AlphaCharP char)) + (FMEMB char addAlphaCharCodes) + (AND allowWildCards (EQ char (CONSTANT (CHARCODE *] + (COND + ((NULL start) + [COND + (number (SETQ start (IDIFFERENCE i 2)) (* we have a number followed by some characters. - (e.g. 7th, 21st, etc.) Take in the last digit of the number.) - - (RPLCHARCODE word 1 number) - (SETQ number NIL)) - (T (SETQ start (SUB1 i] - (RPLCHARCODE word (IDIFFERENCE i start) - char] - [(AND char (NUMBERP char) - (IGEQ char 48) - (ILEQ char 57)) (* a number) - (COND - ((NULL start) - (SETQ number char) - (SETQ initialQuote NIL)) - (T (RPLCHARCODE word (IDIFFERENCE i start) - char] - ((AND start char (FMEMB char optSeprCodes)) (* optSeprCodes may or may not be a - part of the word.) - (push seprs i)) - [start (* AND char (add length -1)) + (e.g. 7th, 21st, etc.) Take in the last digit of the number.) + + (RPLCHARCODE word 1 number) + (SETQ number NIL)) + (T (SETQ start (SUB1 i] + (RPLCHARCODE word (IDIFFERENCE i start) + char] + [(AND char (NUMBERP char) + (IGEQ char 48) + (ILEQ char 57)) (* a number) + (COND + ((NULL start) + (SETQ number char) + (SETQ initialQuote NIL)) + (T (RPLCHARCODE word (IDIFFERENCE i start) + char] + ((AND start char (FMEMB char optSeprCodes)) (* optSeprCodes may or may not be a + part of the word.) + (push seprs i)) + [start (* AND char (add length -1)) (* back up to the last legal char.) (* * find the longest string of characters seperated by seprs that the analyzer - accepts.) - - (COND - ((NULL seprs) - (SETQ seprs i)) - (T (push seprs i))) - [for stop inside seprs - do (SETQ length (SUB1 (IDIFFERENCE stop start))) - (COND - ([SETQ lookup (OR (Analyzer.Lookup analyzer word 0 length) - (AND userDict (SimpleDict.Lookup userDict - word length] - (RETURN)) - ((AND initialQuote (EQP length 1) - (EQ (NTHCHARCODE word 1) - (CHARCODE s))) - (SETQ lookup 'possessive) - (RETURN] + accepts.) + + (COND + ((NULL seprs) + (SETQ seprs i)) + (T (push seprs i))) + [for stop inside seprs do (SETQ length (SUB1 (IDIFFERENCE stop start))) + (COND + ([SETQ lookup (OR (Analyzer.Lookup analyzer word 0 + length) + (AND userDict + (SimpleDict.Lookup userDict + word length] + (RETURN)) + ((AND initialQuote (EQP length 1) + (EQ (NTHCHARCODE word 1) + (CHARCODE s))) + (SETQ lookup 'possessive) + (RETURN] (* * apply NWFn and return its value if non-NIL.) - (COND - ((AND (NULL NWFn) - (NEQ lookup 'possessive)) - (RETURN (CONS start length))) - ((AND (NEQ lookup 'possessive) - (SETQ lookup (APPLY* NWFn analyzer stream start length lookup))) - (RETURN lookup)) - (T (COND - ((NEQ i (IPLUS start length 1)) - (* we regressed.) - (SETQ i (IPLUS start length)) + (COND + ((AND (NULL NWFn) + (NEQ lookup 'possessive)) + (RETURN (CONS start length))) + ((AND (NEQ lookup 'possessive) + (SETQ lookup (APPLY* NWFn analyzer stream start length lookup))) + (RETURN lookup)) + (T (COND + ((NEQ i (IPLUS start length 1)) (* we regressed.) + (SETQ i (IPLUS start length)) (* don't add 1 so that we will see the quote and initialQuote will get set - ("time's")) - - (SETFILEPTR stream i) (* set char to T to prevent the - RETURN at the end of the loop.) - (SETQ char T))) - (SETQ start NIL) - (SETQ seprs NIL) - (SETQ initialQuote NIL] - (T (SETQ number NIL) - (SETQ initialQuote (EQ char (CHARCODE %'] - (OR char (RETURN]) + ("time's")) + + (SETFILEPTR stream i) (* set char to T to prevent the RETURN + at the end of the loop.) + (SETQ char T))) + (SETQ start NIL) + (SETQ seprs NIL) + (SETQ initialQuote NIL] + (T (SETQ number NIL) + (SETQ initialQuote (EQ char (CHARCODE %'] + (OR char (RETURN]) (Analyzer.DefaultProofread - [LAMBDA (analyzer stream begin length) (* jtm%: "16-Dec-87 13:07") + [LAMBDA (analyzer stream begin length) (* jtm%: "16-Dec-87 13:07") (PROG (start.length correction startTime stopTime char (n 0)) (TEDIT.PROMPTPRINT stream "Proofreading . . . " T) @@ -571,59 +552,58 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res [COND ((NEQ length 0) (while (AND (NUMBERP (SETQ char (BIN stream))) - (ALPHACHARP char)) do (COND - ((EQUAL begin 0) - (RETURN)) - (T (add begin -1) - (add length 1) - (SETFILEPTR stream begin] + (ALPHACHARP char)) do (COND + ((EQUAL begin 0) + (RETURN)) + (T (add begin -1) + (add length 1) + (SETFILEPTR stream begin] (* * look for the next spelling error.) [while [SETQ start.length (Analyzer.Analyze analyzer stream begin length - (FUNCTION (LAMBDA (analyzer stream start length - entries) - (add n 1) - (COND - ((NULL entries) - (CONS start length] + (FUNCTION (LAMBDA (analyzer stream start length entries) + (add n 1) + (COND + ((NULL entries) + (CONS start length] do - (* * start.length is a CONS pair of locations delimiting an unrecognizable - word. Set the selection to it and display it.) - - [COND - ((AND Proofreader.UserFns (for fn (word _ (STREAM.FETCHSTRING - stream - (CAR start.length) - (CDR start.length))) - inside Proofreader.UserFns - thereis (APPLY* fn word))) - (SETQ correction '*SKIP*)) - (T (TEDIT.SETSEL stream (ADD1 (CAR start.length)) - (CDR start.length) - 'RIGHT T) - (TEDIT.SHOWSEL stream NIL) - (TEDIT.NORMALIZECARET stream) - (TEDIT.SHOWSEL stream T) - (COND - ([NOT (AND Proofreader.AutoCorrect (SETQ correction (TEdit.Correct - stream analyzer T] - (RETURN] - (COND - [(FMEMB correction '(*SKIP* *INSERT*)) - [add length (IDIFFERENCE begin (IPLUS (CAR start.length) - (CDR start.length] - (SETQ begin (IPLUS (CAR start.length) - (CDR start.length] - ((STRINGP correction) - (add length (IDIFFERENCE begin (CAR start.length))) + (* * start.length is a CONS pair of locations delimiting an unrecognizable word. + Set the selection to it and display it.) + + [COND + ((AND Proofreader.UserFns (for fn (word _ (STREAM.FETCHSTRING stream (CAR + start.length + ) + (CDR start.length))) inside + + Proofreader.UserFns + thereis (APPLY* fn word))) + (SETQ correction '*SKIP*)) + (T (TEDIT.SETSEL stream (ADD1 (CAR start.length)) + (CDR start.length) + 'RIGHT T) + (TEDIT.SHOWSEL stream NIL) + (TEDIT.NORMALIZECARET stream) + (TEDIT.SHOWSEL stream T) + (COND + ([NOT (AND Proofreader.AutoCorrect (SETQ correction (TEdit.Correct stream + analyzer T] + (RETURN] + (COND + [(FMEMB correction '(*SKIP* *INSERT*)) + [add length (IDIFFERENCE begin (IPLUS (CAR start.length) + (CDR start.length] + (SETQ begin (IPLUS (CAR start.length) + (CDR start.length] + ((STRINGP correction) + (add length (IDIFFERENCE begin (CAR start.length))) (* move start point.) - (add length (IDIFFERENCE (NCHARS correction) - (CDR start.length))) - (* adjust for correction.) - (SETQ begin (CAR start.length))) - (T (SHOULDNT] + (add length (IDIFFERENCE (NCHARS correction) + (CDR start.length))) (* adjust for correction.) + (SETQ begin (CAR start.length))) + (T (SHOULDNT] (SETQ stopTime (CLOCK 0)) (COND (Analyzer.TimeProofreader (TEDIT.PROMPTPRINT stream (CONCAT "Elapsed Time: " @@ -654,7 +634,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DEFINEQ (Analyzer.DefaultLoadWordList - [LAMBDA (analyzer file) (* jtm%: "17-Sep-86 09:39") + [LAMBDA (analyzer file) (* jtm%: "17-Sep-86 09:39") (* * adds a word list to the given analyzer.) @@ -664,7 +644,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (Analyzer.PushProp analyzer 'WordListFile file]) (Analyzer.DefaultStoreWordList - [LAMBDA (analyzer file) (* jtm%: "23-Sep-86 09:08") + [LAMBDA (analyzer file) (* jtm%: "23-Sep-86 09:08") (* * adds the current word list to the remote file.) @@ -678,7 +658,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (Analyzer.Prop analyzer 'WordList NIL]) (Analyzer.ReadWordList - [LAMBDA (file) (* ; "Edited 9-Mar-89 15:22 by jtm:") + [LAMBDA (file) (* ; "Edited 9-Mar-89 15:22 by jtm:") (PROG (firstWord word words stream) (SETQ stream (OPENSTREAM file 'INPUT)) (SETFILEPTR stream 0) @@ -691,17 +671,17 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res [COND ((NULL WORDLISTRDTBL) (SETQ WORDLISTRDTBL (CREATEWORDLISTRDTBL] - [while (SKIPSEPRCODES stream WORDLISTRDTBL) - do (SETQ word (RSTRING stream WORDLISTRDTBL)) - (COND - ((EQ 0 (NCHARS word)) - (BIN stream)) - (T (push words word] + [while (SKIPSEPRCODES stream WORDLISTRDTBL) do (SETQ word (RSTRING stream + WORDLISTRDTBL)) + (COND + ((EQ 0 (NCHARS word)) + (BIN stream)) + (T (push words word] (CLOSEF stream) (RETURN words]) (Analyzer.WriteWordList - [LAMBDA (wordList file) (* jtm%: "17-Sep-86 10:11") + [LAMBDA (wordList file) (* jtm%: "17-Sep-86 10:11") (PROG (stream) (SETQ stream (OPENSTREAM file 'OUTPUT)) (SETFILEPTR stream 0) @@ -709,13 +689,13 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (CLOSEF stream]) (CREATEWORDLISTRDTBL - [LAMBDA NIL (* jtm%: "17-Sep-86 10:55") + [LAMBDA NIL (* jtm%: "17-Sep-86 10:55") (LET (RDTBL) (SETQ RDTBL (COPYREADTABLE 'ORIG)) (for SEPR in (GETSEPR RDTBL) do (SETSYNTAX (CHARACTER SEPR) - 'OTHER RDTBL)) + 'OTHER RDTBL)) (for BREAK in (GETBRK RDTBL) do (SETSYNTAX (CHARACTER BREAK) - 'OTHER RDTBL)) + 'OTHER RDTBL)) (SETSYNTAX (CHARACTER (CHARCODE CR)) 'SEPR RDTBL) RDTBL]) @@ -725,7 +705,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DEFINEQ (Analyzer.Prop - [LAMBDA a (* jtm%: "13-Oct-87 11:54") + [LAMBDA a (* jtm%: "13-Oct-87 11:54") (LET (p (analyzer (ARG a 1)) (prop (ARG a 2))) (SETQ p (FASSOC prop (fetch (Morphalyzer analyzerProps) of analyzer))) @@ -735,10 +715,10 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res [p (PROG1 (CDR p) (RPLACD p (ARG a 3)))] (T (CDAR (push (fetch (Morphalyzer analyzerProps) of analyzer) - (CONS prop (ARG a 3]) + (CONS prop (ARG a 3]) (Analyzer.PushProp - [LAMBDA (analyzer prop value) (* jtm%: "13-Oct-87 10:59") + [LAMBDA (analyzer prop value) (* jtm%: "13-Oct-87 10:59") (* * pushes value onto a list of values stored at prop.) @@ -746,50 +726,49 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (COND [(NULL prop.values) (push (fetch (Morphalyzer analyzerProps) of analyzer) - (CONS prop (LIST value] + (CONS prop (LIST value] ((NOT (for i in (CDR prop.values) thereis (EQUAL i value))) (push (CDR prop.values) - value))) + value))) value]) ) (DECLARE%: EVAL@COMPILE (PUTPROPS Analyzer.AlphaCharP MACRO [(CHAR) - (OR (EQ (LRSH CHAR 8) - 241) - ([LAMBDA (UCHAR) - (DECLARE (LOCALVARS UCHAR)) - (OR (EQ (LRSH UCHAR 8) - 241) - (AND (IGEQ UCHAR (CHARCODE A)) - (ILEQ UCHAR (CHARCODE Z] - (LOGAND CHAR 95]) + (OR (EQ (LRSH CHAR 8) + 241) + ([LAMBDA (UCHAR) + (DECLARE (LOCALVARS UCHAR)) + (OR (EQ (LRSH UCHAR 8) + 241) + (AND (IGEQ UCHAR (CHARCODE A)) + (ILEQ UCHAR (CHARCODE Z] + (LOGAND CHAR 95]) (PUTPROPS \Analyzer.TestCorruption MACRO [(analyzer word wordList userDict) - (COND - ((OR (Analyzer.Lookup analyzer word) - (AND userDict (SimpleDict.Lookup - userDict word))) - (push wordList (CONCATCODES word]) + (COND + ((OR (Analyzer.Lookup analyzer word) + (AND userDict (SimpleDict.Lookup userDict word))) + (push wordList (CONCATCODES word]) (PUTPROPS Analyzer.Capitalization MACRO [(word) (* * returns NIL, ALL or FIRST) - (COND - ((AND (CAR word) - (Analyzer.UCaseP (CAR word))) - (COND - ((AND (CADR word) - (Analyzer.UCaseP (CADR word))) - 'ALL) - (T 'FIRST]) + (COND + ((AND (CAR word) + (Analyzer.UCaseP (CAR word))) + (COND + ((AND (CADR word) + (Analyzer.UCaseP (CADR word))) + 'ALL) + (T 'FIRST]) (PUTPROPS Analyzer.UCaseP MACRO [(UCHAR) - (OR (AND (IGEQ UCHAR (CHARCODE 361,041)) - (ILEQ UCHAR (CHARCODE 361,160))) - (AND (IGEQ UCHAR (CHARCODE A)) - (ILEQ UCHAR (CHARCODE Z]) + (OR (AND (IGEQ UCHAR (CHARCODE 361,041)) + (ILEQ UCHAR (CHARCODE 361,160))) + (AND (IGEQ UCHAR (CHARCODE A)) + (ILEQ UCHAR (CHARCODE Z]) ) @@ -799,7 +778,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DEFINEQ (STREAM.FETCHSTRING - [LAMBDA (stream start length buffer restorePtr) (* jtm%: " 3-Apr-87 11:28") + [LAMBDA (stream start length buffer restorePtr) (* jtm%: " 3-Apr-87 11:28") (LET (pos) [COND (restorePtr (SETQ pos (GETFILEPTR stream] @@ -816,38 +795,38 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DECLARE%: EVAL@COMPILE (PUTPROPS Stream.Init MACRO [(stream start length) - (COND - [(STRINGP stream) - (OR start (SETQ start 0)) - (OR length (SETQ length (NCHARS stream] - ((NOT (LISTP stream)) - (COND - ((NULL start) - (SETQ start 0))) - [COND - ((NULL length) - (SETQ length (IDIFFERENCE (GETEOFPTR stream) - start] - (SETFILEPTR stream start]) + (COND + [(STRINGP stream) + (OR start (SETQ start 0)) + (OR length (SETQ length (NCHARS stream] + ((NOT (LISTP stream)) + (COND + ((NULL start) + (SETQ start 0))) + [COND + ((NULL length) + (SETQ length (IDIFFERENCE (GETEOFPTR stream) + start] + (SETFILEPTR stream start]) (PUTPROPS Stream.NextChar MACRO [(stream length index) - (COND - ((LISTP stream) - (pop stream)) - ((OR (NULL stream) - (ILEQ length 0)) - NIL) - ((STRINGP stream) - (add length -1) - (add index 1) - (NTHCHARCODE stream index)) - (T (add length -1) - (BIN stream]) + (COND + ((LISTP stream) + (pop stream)) + ((OR (NULL stream) + (ILEQ length 0)) + NIL) + ((STRINGP stream) + (add length -1) + (add index 1) + (NTHCHARCODE stream index)) + (T (add length -1) + (BIN stream]) ) (DEFINEQ (Analyzer.CorruptWord - [LAMBDA (analyzer stream start length) (* jtm%: " 5-Feb-87 11:23") + [LAMBDA (analyzer stream start length) (* jtm%: " 5-Feb-87 11:23") (* * returns a list of possible spelling corrections for the given word.) @@ -857,20 +836,21 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (* * first try transpositions) - (for tail temp on word while (CDR tail) - do (SETQ temp (CAR tail)) - (RPLACA tail (CADR tail)) - (RPLACA (CDR tail) - temp) - (COND - ((AND (EQ caps 'FIRST) - (EQ tail word)) (* don't transpose the first letters - of a capitalized word.) - NIL) - (T (\Analyzer.TestCorruption analyzer word wordList))) - (RPLACA (CDR tail) - (CAR tail)) - (RPLACA tail temp)) + (for tail temp on word while (CDR tail) do (SETQ temp (CAR tail)) + (RPLACA tail (CADR tail)) + (RPLACA (CDR tail) + temp) + (COND + ((AND (EQ caps 'FIRST) + (EQ tail word)) + (* don't transpose the first letters + of a capitalized word.) + NIL) + (T (\Analyzer.TestCorruption analyzer word + wordList))) + (RPLACA (CDR tail) + (CAR tail)) + (RPLACA tail temp)) (* * next try deletions) @@ -879,77 +859,68 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (\Analyzer.TestCorruption analyzer (CDR word) wordList))) (for tail temp on word while (CDR tail) do (SETQ temp (CDR tail)) - (RPLACD tail (CDDR tail)) - (\Analyzer.TestCorruption - analyzer word wordList) - (RPLACD tail temp)) + (RPLACD tail (CDDR tail)) + (\Analyzer.TestCorruption analyzer word wordList + ) + (RPLACD tail temp)) (* * prepend a character.) (SETQ word (CONS 'A word)) (SELECTQ caps - (FIRST (* don't prepend a character before - a capitalized word.) + (FIRST (* don't prepend a character before a + capitalized word.) NIL) (ALL (* prepend a capital letter.) - (for c from (CHARCODE A) to (CHARCODE Z) - do (RPLACA word c) - (\Analyzer.TestCorruption analyzer word wordList))) + (for c from (CHARCODE A) to (CHARCODE Z) do (RPLACA word c) + (\Analyzer.TestCorruption analyzer + word wordList))) (for c from (CHARCODE a) to (CHARCODE z) do (RPLACA word c) - (\Analyzer.TestCorruption - analyzer word wordList))) + (\Analyzer.TestCorruption analyzer word + wordList))) (SETQ word (CDR word)) (* * insert characters.) (for tail on word do (RPLACD tail (CONS 'A (CDR tail))) - [COND - ((EQ caps 'ALL) - (for c from (CHARCODE A) - to (CHARCODE Z) - do (RPLACA (CDR tail) - c) - (\Analyzer.TestCorruption analyzer word - wordList))) - (T (for c from (CHARCODE a) - to (CHARCODE z) - do (RPLACA (CDR tail) - c) - (\Analyzer.TestCorruption analyzer word - wordList] - (RPLACD tail (CDDR tail))) + [COND + ((EQ caps 'ALL) + (for c from (CHARCODE A) to (CHARCODE Z) + do (RPLACA (CDR tail) + c) + (\Analyzer.TestCorruption analyzer word wordList))) + (T (for c from (CHARCODE a) to (CHARCODE z) + do (RPLACA (CDR tail) + c) + (\Analyzer.TestCorruption analyzer word wordList] + (RPLACD tail (CDDR tail))) (* * replace characters) (for tail temp on word do (SETQ temp (CAR tail)) - [COND - ((OR (EQ caps 'ALL) - (AND (EQ caps 'FIRST) - (EQ tail word))) - (for c from (CHARCODE A) - to (CHARCODE Z) - do (RPLACA tail c) - (COND - ((EQ temp c)) - (T (\Analyzer.TestCorruption analyzer - word wordList] - [COND - ((OR (EQ caps NIL) - (NOT (ALPHACHARP temp)) - (AND (EQ caps 'FIRST) - (NEQ tail word))) - (for c from (CHARCODE a) - to (CHARCODE z) - do (RPLACA tail c) - (COND - ((EQ temp (CHARACTER c))) - (T (\Analyzer.TestCorruption analyzer - word wordList] - (RPLACA tail temp)) + [COND + ((OR (EQ caps 'ALL) + (AND (EQ caps 'FIRST) + (EQ tail word))) + (for c from (CHARCODE A) to (CHARCODE Z) + do (RPLACA tail c) + (COND + ((EQ temp c)) + (T (\Analyzer.TestCorruption analyzer word wordList] + [COND + ((OR (EQ caps NIL) + (NOT (ALPHACHARP temp)) + (AND (EQ caps 'FIRST) + (NEQ tail word))) + (for c from (CHARCODE a) to (CHARCODE z) + do (RPLACA tail c) + (COND + ((EQ temp (CHARACTER c))) + (T (\Analyzer.TestCorruption analyzer word wordList] + (RPLACA tail temp)) (SETQ wordList (SORT wordList)) [for i on wordList do (while (STREQUAL (CAR i) - (CADR i)) - do (RPLACD i (CDR i] + (CADR i)) do (RPLACD i (CDR i] (RETURN wordList]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -964,19 +935,19 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DEFINEQ (Analyzer.Establish - [LAMBDA (analyzer) (* jtm%: "13-Oct-87 10:44") + [LAMBDA (analyzer) (* jtm%: "13-Oct-87 10:44") (AND analyzer (OR (AND (BOUNDP 'Analyzer.List) - (bind (analyzerName _ (fetch (Morphalyzer analyzerName) - of analyzer)) for tail on - Analyzer.List - when (EQUAL analyzerName (fetch (Morphalyzer analyzerName) - of (CAR tail))) + (bind (analyzerName _ (fetch (Morphalyzer analyzerName) of analyzer)) + for tail on Analyzer.List when (EQUAL analyzerName (fetch (Morphalyzer + analyzerName + ) + of (CAR tail))) do (RPLACA tail analyzer) - (RETURN T))) + (RETURN T))) (push Analyzer.List analyzer]) (AnalyzerForStream - [LAMBDA (stream) (* jtm%: " 2-Oct-85 14:00") + [LAMBDA (stream) (* jtm%: " 2-Oct-85 14:00") (* * comment) @@ -985,7 +956,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (T (TEdit.SetAnalyzer stream]) (Analyzer.QuitFn - [LAMBDA (window stream textObj) (* jtm%: "14-Jan-86 15:58") + [LAMBDA (window stream textObj) (* jtm%: "14-Jan-86 15:58") (* * ask the user if he wants to save the word list.) @@ -997,32 +968,32 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (TEdit.StoreWordList stream]) (Analyzer.BeforeLogout - [LAMBDA NIL (* jtm%: "13-Oct-87 10:45") + [LAMBDA NIL (* jtm%: "13-Oct-87 10:45") (for analyzer file in Analyzer.List do (COND - ([AND (Analyzer.Prop analyzer 'WordList) - (EQ 'Y (ASKUSER 10 'N (CONCAT "Do you want to save the word list for " - (fetch (Morphalyzer analyzerName) - of analyzer) - "? "] - (COND - ([NULL (SETQ file (PROMPTFORWORD "Store word list on file:" - (CAR (Analyzer.Prop analyzer 'WordListFile] - (printout T "Aborted.")) - (T (RESETLST - (printout T (CONCAT "Storing word list on " file "...")) - (Analyzer.DefaultStoreWordList analyzer file) - (printout T "Deleting old version...") - (RESETSAVE (TTYDISPLAYSTREAM (OPENTEXTSTREAM))) + ([AND (Analyzer.Prop analyzer 'WordList) + (EQ 'Y (ASKUSER 10 'N (CONCAT "Do you want to save the word list for " + (fetch (Morphalyzer analyzerName) of analyzer) + "? "] + (COND + ([NULL (SETQ file (PROMPTFORWORD "Store word list on file:" + (CAR (Analyzer.Prop analyzer 'WordListFile] + (printout T "Aborted.")) + (T (RESETLST + (printout T (CONCAT "Storing word list on " file "...")) + (Analyzer.DefaultStoreWordList analyzer file) + (printout T "Deleting old version...") + (RESETSAVE (TTYDISPLAYSTREAM (OPENTEXTSTREAM))) (* to swallow up the output of - DIRECTORY) - (DIRECTORY file '(DELVER))) - (printout T "done."]) + DIRECTORY) + (DIRECTORY file '(DELVER))) + (printout T "done."]) ) (DEFINEQ (TEdit.ProofreadMenu - [LAMBDA (stream) (* ; "Edited 11-Jul-88 11:02 by jop") + [LAMBDA (stream) (* ; "Edited 21-Jul-2025 23:20 by rmk") + (* ; "Edited 11-Jul-88 11:02 by jop") (* ;;; "TEDIT interface to the current analyzer.") @@ -1030,7 +1001,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (* ;; "COND ((WINDOWPROP W (QUOTE DEFWINDOW)) (* so they don't interfere.) (CLOSEW (WINDOWPROP W (QUOTE DEFWINDOW))))") - [SETQ W (CAR (fetch \WINDOW of (TEXTOBJ stream] + (SETQ W (TEDITWINDOWP stream)) (SETQ menuWindow (WINDOWPROP W 'Proofreader.Menu)) (COND ((NULL menuWindow) @@ -1064,7 +1035,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (* ;; "(CAR (WINDOWPROP W (QUOTE PROMPTWINDOW)))") (* ;; - "if you attach the menuWindow to W, then it gets attached to the top-most TEdit menu.") + "if you attach the menuWindow to W, then it gets attached to the top-most TEdit menu.") (OPENW menuWindow))) [COND @@ -1073,7 +1044,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (RETURN menuWindow]) (PROOFREADER.WHENSELECTEDFN - [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 11-Jul-88 10:58 by jop") + [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 11-Jul-88 10:58 by jop") (LET [(W (MAINWINDOW (WFROMMENU MENU] (SELECTQ (CADR ITEM) (Proofread (WITH-TEDIT W (FUNCTION TEdit.Proofread))) @@ -1083,7 +1054,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res NIL]) (WITH-TEDIT - [LAMBDA (TEXTOBJ FUNCTION) (* jtm%: "30-Mar-87 14:07") + [LAMBDA (TEXTOBJ FUNCTION) (* jtm%: "30-Mar-87 14:07") (LET (EDITOP) [COND ((WINDOWP TEXTOBJ) @@ -1102,7 +1073,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (APPLY* FUNCTION TEXTOBJ))]) (TEdit.Correct - [LAMBDA (stream analyzer autoCorrect) (* jtm%: "30-Mar-87 14:09") + [LAMBDA (stream analyzer autoCorrect) (* ; "Edited 21-Jul-2025 23:21 by rmk") + (* jtm%: "30-Mar-87 14:09") (PROG (selection correction start length items menuWindow) [COND ((WINDOWP stream) @@ -1110,7 +1082,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (SETQ stream (TEXTSTREAM stream))) ((type? TEXTOBJ stream) (SETQ stream (TEXTSTREAM stream))) - (T (SETQ menuWindow (WINDOWPROP (CAR (fetch \WINDOW of (TEXTOBJ stream))) + (T (SETQ menuWindow (WINDOWPROP (TEDITWINDOWP stream) 'Proofreader.Menu] (COND ([AND (NULL analyzer) @@ -1153,7 +1125,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (RETURN correction]) (TEdit.CountWords - [LAMBDA (stream) (* jtm%: "30-Mar-87 14:11") + [LAMBDA (stream) (* jtm%: "30-Mar-87 14:11") (LET (selection n) [COND ((OR (WINDOWP stream) @@ -1173,7 +1145,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res n]) (TEdit.AddEntry - [LAMBDA (stream analyzer) (* jtm%: "30-Mar-87 14:11") + [LAMBDA (stream analyzer) (* jtm%: "30-Mar-87 14:11") (PROG (word) [COND ((OR (WINDOWP stream) @@ -1193,7 +1165,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (T (TEDIT.PROMPTPRINT stream "No analyzer selected." T]) (TEdit.Proofread - [LAMBDA (W) (* jtm%: "16-Dec-87 13:06") + [LAMBDA (W) (* jtm%: "16-Dec-87 13:06") (LET (sel string (stream (TEXTSTREAM W))) (SETQ sel (TEDIT.GETSEL stream)) (SETQ string (STREAM.FETCHSTRING stream (SUB1 (fetch (SELECTION CH#) of sel)) @@ -1209,7 +1181,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (SUB1 (TEDIT.GETPOINT stream]) (TEdit.SetAnalyzer - [LAMBDA (stream analyzer) (* jtm%: "28-Aug-86 09:15") + [LAMBDA (stream analyzer) (* jtm%: "28-Aug-86 09:15") (* * sets the analyzer property for the window) @@ -1218,9 +1190,9 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res ((NULL analyzer) [SETQ menuItems (for i in Analyzer.List collect (LIST (Analyzer.Name i) - (LIST 'QUOTE i) - (if (Analyzer.Prop i 'RemoteDict) - then "Calls the remote dictionary server"] + (LIST 'QUOTE i) + (if (Analyzer.Prop i 'RemoteDict) + then "Calls the remote dictionary server"] [COND ((NULL menuItems)) ((EQ 1 (LENGTH menuItems)) @@ -1255,7 +1227,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res analyzer]) (TEdit.LoadWordList - [LAMBDA (stream) (* jtm%: " 9-Oct-85 10:39") + [LAMBDA (stream) (* jtm%: " 9-Oct-85 10:39") (* * reads a word list from a remote file and adds it to the given analyzer.) @@ -1271,7 +1243,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (TEDIT.PROMPTPRINT stream "done."]) (TEdit.StoreWordList - [LAMBDA (stream) (* jtm%: "28-Jan-87 08:59") + [LAMBDA (stream) (* jtm%: "28-Jan-87 08:59") (* * stores the word list for the given analyzer on a remote file.) @@ -1287,7 +1259,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (T (RESETLST (RESETSAVE (TTYDISPLAYSTREAM (OPENTEXTSTREAM))) (* to swallow up the output of - DIRECTORY) + DIRECTORY) (TEDIT.PROMPTPRINT stream (CONCAT "Storing word list on " file "...") T) (Analyzer.DefaultStoreWordList analyzer file) @@ -1297,7 +1269,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (TEDIT.PROMPTPRINT stream "done."))]) (Analyzer.TEditMenuItems - [LAMBDA NIL (* jtm%: "23-Oct-87 08:58") + [LAMBDA NIL (* jtm%: "23-Oct-87 08:58") (AND (BOUNDP 'TEDIT.DEFAULT.MENU) (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Proofread (FUNCTION TEdit.ProofreadMenu) @@ -1373,13 +1345,13 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DECLARE%: EVAL@COMPILE (DATATYPE Dict (dictName contents analyzer dictProps subDictionaries openFn closeFn getEntryFn - putEntryFn mapFn printEntryFn) - openFn _ (FUNCTION NILL) - closeFn _ (FUNCTION NILL) - getEntryFn _ (FUNCTION NILL) - putEntryFn _ (FUNCTION NILL) - mapFn _ (FUNCTION NILL) - printEntryFn _ (FUNCTION NILL)) + putEntryFn mapFn printEntryFn) + openFn _ (FUNCTION NILL) + closeFn _ (FUNCTION NILL) + getEntryFn _ (FUNCTION NILL) + putEntryFn _ (FUNCTION NILL) + mapFn _ (FUNCTION NILL) + printEntryFn _ (FUNCTION NILL)) ) (/DECLAREDATATYPE 'Dict '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER @@ -1399,33 +1371,32 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DECLARE%: EVAL@COMPILE (PUTPROPS Dict.Open MACRO ((dict) - (APPLY* (fetch (Dict openFn) of dict) - dict))) + (APPLY* (fetch (Dict openFn) of dict) + dict))) (PUTPROPS Dict.Close MACRO ((dict) - (APPLY* (fetch (Dict closeFn) of dict) - dict))) + (APPLY* (fetch (Dict closeFn) of dict) + dict))) (PUTPROPS Dict.GetEntry MACRO ((dict uniqueID prop) - (APPLY* (fetch (Dict getEntryFn) of dict) - dict uniqueID prop))) + (APPLY* (fetch (Dict getEntryFn) of dict) + dict uniqueID prop))) (PUTPROPS Dict.PutEntry MACRO ((dict uniqueID entry prop) - (APPLY* (fetch putEntryFn of dict) - dict uniqueID entry prop))) + (APPLY* (fetch putEntryFn of dict) + dict uniqueID entry prop))) (PUTPROPS Dict.PrintEntry MACRO ((dict entry stream) - (APPLY* [COND - ((type? Dict dict) - (fetch (Dict printEntryFn) of dict)) - ((type? INVERTEDDICT dict) - (InvertedDict.Prop dict 'PRINTENTRYFN] - dict entry stream))) - -(PUTPROPS Dict.MapEntries MACRO ((dict MpFn prop topOnly) - (* MpFn (dict uniqueId entry prop)) - (APPLY* (fetch (Dict mapFn) of dict) - dict MpFn prop topOnly))) + (APPLY* [COND + ((type? Dict dict) + (fetch (Dict printEntryFn) of dict)) + ((type? INVERTEDDICT dict) + (InvertedDict.Prop dict 'PRINTENTRYFN] + dict entry stream))) + +(PUTPROPS Dict.MapEntries MACRO ((dict MpFn prop topOnly) (* MpFn (dict uniqueId entry prop)) + (APPLY* (fetch (Dict mapFn) of dict) + dict MpFn prop topOnly))) ) @@ -1435,30 +1406,25 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DEFINEQ (DictFromName - [LAMBDA (dictName remoteName) (* ; "Edited 6-Oct-88 09:42 by jtm:") + [LAMBDA (dictName remoteName) (* ; "Edited 6-Oct-88 09:42 by jtm:") (PROG (dict COLONPOS) [COND ((NULL dictName) (SETQ dict (CAR Dict.DictionaryList))) - [(for i in Dict.DictionaryList - do (COND - ([AND (EQ dictName (fetch (Dict dictName) of i)) - (EQ remoteName (Dict.Prop i 'RemoteDict] - (SETQ dict i) - (RETURN T] + [(for i in Dict.DictionaryList do (COND + ([AND (EQ dictName (fetch (Dict dictName) + of i)) + (EQ remoteName (Dict.Prop i 'RemoteDict] + (SETQ dict i) + (RETURN T] [(for i in InvertedDict.List do (COND - ([AND (EQ dictName (fetch - (INVERTEDDICT - INVERTEDDICTNAME - ) of - i)) - (EQ remoteName (InvertedDict.Prop - i - 'RemoteDict)) - (SETQ dict (InvertedDict.Prop - i - 'DICTIONARY] - (RETURN T] + ([AND (EQ dictName (fetch (INVERTEDDICT + INVERTEDDICTNAME) + of i)) + (EQ remoteName (InvertedDict.Prop i + 'RemoteDict)) + (SETQ dict (InvertedDict.Prop i 'DICTIONARY] + (RETURN T] ((SETQ COLONPOS (STRPOS ":" dictName)) (SETQ dict (DictFromName (SUBATOM dictName 1 (SUB1 COLONPOS)) (SUBATOM dictName (IPLUS COLONPOS 2) @@ -1466,18 +1432,16 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (RETURN dict]) (Dict.Establish - [LAMBDA (dict) (* jtm%: "13-Oct-87 10:45") + [LAMBDA (dict) (* jtm%: "13-Oct-87 10:45") (OR (AND (BOUNDP 'Dict.DictionaryList) - (bind (dictName _ (fetch (Dict dictName) of dict)) for tail on - - Dict.DictionaryList + (bind (dictName _ (fetch (Dict dictName) of dict)) for tail on Dict.DictionaryList when (EQUAL dictName (fetch (Dict dictName) of (CAR tail))) do (RPLACA tail dict) - (RETURN T))) + (RETURN T))) (push Dict.DictionaryList dict]) (Dict.Prop - [LAMBDA a (* jtm%: "13-Oct-87 11:54") + [LAMBDA a (* jtm%: "13-Oct-87 11:54") (LET (p (dict (ARG a 1)) (prop (ARG a 2))) (SETQ p (FASSOC prop (fetch (Dict dictProps) of dict))) @@ -1487,10 +1451,10 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res [p (PROG1 (CDR p) (RPLACD p (ARG a 3)))] (T (CDAR (push (fetch (Dict dictProps) of dict) - (CONS prop (ARG a 3]) + (CONS prop (ARG a 3]) (Dict.Name - [LAMBDA (dict) (* jtm%: "13-Oct-87 10:45") + [LAMBDA (dict) (* jtm%: "13-Oct-87 10:45") (COND [(Dict.Prop dict 'RemoteDict) (MKATOM (CONCAT (fetch (Dict dictName) of dict) @@ -1512,7 +1476,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DEFINEQ (SimpleDict.New - [LAMBDA (name) (* jtm%: "13-Oct-87 10:40") + [LAMBDA (name) (* jtm%: "13-Oct-87 10:40") (create Dict dictName _ name getEntryFn _ (FUNCTION SimpleDict.Lookup) @@ -1521,7 +1485,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res contents _ (create SimpleDict.Node]) (SimpleDict.PutEntry - [LAMBDA (dict entry value) (* jtm%: " 5-Feb-87 11:29") + [LAMBDA (dict entry value) (* jtm%: " 5-Feb-87 11:29") (* * adds the value to dict under entry.) @@ -1533,33 +1497,29 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res ((STRINGP entry) (for i char from 1 to (NCHARS entry) do (SETQ char (NTHCHAR entry i)) - (COND - ([NOT (SETQ subNode (FASSOC char (fetch (SimpleDict.Node subnodes) - of node] - (SETQ subNode (create SimpleDict.Node - char _ char)) - (push (fetch (SimpleDict.Node subnodes) of node) - subNode))) - (SETQ node subNode)) + (COND + ([NOT (SETQ subNode (FASSOC char (fetch (SimpleDict.Node subnodes) of node] + (SETQ subNode (create SimpleDict.Node + char _ char)) + (push (fetch (SimpleDict.Node subnodes) of node) + subNode))) + (SETQ node subNode)) (replace (SimpleDict.Node value) of node with value)) ((LISTP entry) (for char in entry do (COND - ([NOT (SETQ subNode (FASSOC char - (fetch ( - SimpleDict.Node - subnodes) - of node] - (SETQ subNode (create SimpleDict.Node - char _ char)) - (push (fetch (SimpleDict.Node subnodes) - of node) - subNode))) - (SETQ node subNode)) + ([NOT (SETQ subNode (FASSOC char (fetch (SimpleDict.Node + subnodes) + of node] + (SETQ subNode (create SimpleDict.Node + char _ char)) + (push (fetch (SimpleDict.Node subnodes) of node) + subNode))) + (SETQ node subNode)) (replace (SimpleDict.Node value) of node with value))) value]) (SimpleDict.Lookup - [LAMBDA (dict entry length) (* jtm%: " 7-Apr-87 08:28") + [LAMBDA (dict entry length) (* jtm%: " 7-Apr-87 08:28") (* * looks up entry in the dictionary) @@ -1569,32 +1529,26 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (LITATOM entry)) [for i from 1 to (OR length (NCHARS entry)) do (COND - ([NOT (SETQ node (FASSOC (NTHCHAR entry i) - (fetch (SimpleDict.Node subnodes) of - node] - (RETURN] + ([NOT (SETQ node (FASSOC (NTHCHAR entry i) + (fetch (SimpleDict.Node subnodes) of node] + (RETURN] (AND node (RETURN (fetch (SimpleDict.Node value) of node] ((LISTP entry) [for i in entry do (COND - [(AND (NUMBERP i) - (IGREATERP i 9)) - (* a character code.) - (COND - ([NOT (SETQ node (FASSOC (CHARACTER i) - (fetch ( - SimpleDict.Node - subnodes) - of node] - (RETURN] - ([NOT (SETQ node (FASSOC i (fetch ( - SimpleDict.Node - subnodes) - of node] - (RETURN] + [(AND (NUMBERP i) + (IGREATERP i 9)) (* a character code.) + (COND + ([NOT (SETQ node (FASSOC (CHARACTER i) + (fetch (SimpleDict.Node subnodes) + of node] + (RETURN] + ([NOT (SETQ node (FASSOC i (fetch (SimpleDict.Node subnodes) + of node] + (RETURN] (AND node (RETURN (fetch (SimpleDict.Node value) of node]) (SimpleDict.MapEntries - [LAMBDA (dict fn node path) (* jtm%: "11-Apr-86 15:45") + [LAMBDA (dict fn node path) (* jtm%: "11-Apr-86 15:45") (* * maps all of the entries in the dictionary in arbitrary order.) @@ -1605,11 +1559,11 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res ((fetch (SimpleDict.Node value) of node) (APPLY* fn dict path (fetch (SimpleDict.Node value) of node] (for i in (fetch (SimpleDict.Node subnodes) of node) - do (SimpleDict.MapEntries dict fn i (APPEND path (LIST (fetch (SimpleDict.Node - char) of i]) + do (SimpleDict.MapEntries dict fn i (APPEND path (LIST (fetch (SimpleDict.Node char) + of i]) (SimpleDict.PrintEntries - [LAMBDA (dict stream noValues) (* jtm%: "31-Mar-87 07:37") + [LAMBDA (dict stream noValues) (* jtm%: "31-Mar-87 07:37") [Dict.MapEntries dict (FUNCTION (LAMBDA (dict entry value) (COND (noValues (printout stream (CONCATLIST entry) @@ -1619,7 +1573,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res dict]) (SimpleDict.Test - [LAMBDA NIL (* jtm%: "11-Apr-86 15:49") + [LAMBDA NIL (* jtm%: "11-Apr-86 15:49") (* * tests the SimpleDict implementation.) @@ -1640,28 +1594,25 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (DECLARE%: EVAL@COMPILE -(TYPERECORD INVERTEDDICT (INVERTEDDICTNAME HEADERINDEX KEYINDEX INDEXFILE FILEDIR FILENAME - FILEEXT FILEARRAY INVERTEDDICTPROPS)) +(TYPERECORD INVERTEDDICT (INVERTEDDICTNAME HEADERINDEX KEYINDEX INDEXFILE FILEDIR FILENAME FILEEXT + FILEARRAY INVERTEDDICTPROPS)) ) (DEFINEQ (InvertedDictFromName - [LAMBDA (dictName remoteName) (* ; "Edited 6-Oct-88 09:57 by jtm:") + [LAMBDA (dictName remoteName) (* ; "Edited 6-Oct-88 09:57 by jtm:") (PROG (dict COLONPOS) [COND ((NULL dictName) (SETQ dict (CAR InvertedDict.List))) [(for i in InvertedDict.List do (COND - ([AND (EQ dictName (fetch - (INVERTEDDICT - INVERTEDDICTNAME - ) of - i)) - (EQ remoteName (InvertedDict.Prop - i - 'RemoteDict] - (SETQ dict i) - (RETURN T] + ([AND (EQ dictName (fetch (INVERTEDDICT + INVERTEDDICTNAME) + of i)) + (EQ remoteName (InvertedDict.Prop i + 'RemoteDict] + (SETQ dict i) + (RETURN T] ((SETQ COLONPOS (STRPOS ":" dictName)) (SETQ dict (InvertedDictFromName (SUBATOM dictName 1 (SUB1 COLONPOS)) (SUBATOM dictName (IPLUS COLONPOS 2) @@ -1669,16 +1620,15 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (RETURN dict]) (InvertedDict.Establish - [LAMBDA (dict) (* jtm%: "13-Oct-87 10:32") - (OR (bind (name _ (fetch (INVERTEDDICT INVERTEDDICTNAME) of dict)) for tail - on InvertedDict.List when (EQUAL name (fetch (INVERTEDDICT INVERTEDDICTNAME) - of (CAR tail))) + [LAMBDA (dict) (* jtm%: "13-Oct-87 10:32") + (OR (bind (name _ (fetch (INVERTEDDICT INVERTEDDICTNAME) of dict)) for tail on InvertedDict.List + when (EQUAL name (fetch (INVERTEDDICT INVERTEDDICTNAME) of (CAR tail))) do (RPLACA tail dict) - (RETURN T)) + (RETURN T)) (push InvertedDict.List dict]) (InvertedDict.Prop - [LAMBDA a (* jtm%: "13-Oct-87 11:54") + [LAMBDA a (* jtm%: "13-Oct-87 11:54") (LET (p (dict (ARG a 1)) (prop (ARG a 2))) (SETQ p (FASSOC prop (fetch (INVERTEDDICT INVERTEDDICTPROPS) of dict))) @@ -1688,10 +1638,10 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res [p (PROG1 (CDR p) (RPLACD p (ARG a 3)))] (T (CDAR (push (fetch (INVERTEDDICT INVERTEDDICTPROPS) of dict) - (CONS prop (ARG a 3]) + (CONS prop (ARG a 3]) (InvertedDict.Name - [LAMBDA (dict) (* jtm%: "13-Oct-87 10:33") + [LAMBDA (dict) (* jtm%: "13-Oct-87 10:33") (COND [(InvertedDict.Prop dict 'RemoteDict) (MKATOM (CONCAT (fetch (INVERTEDDICT INVERTEDDICTNAME) of dict) @@ -1700,7 +1650,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (T (fetch (INVERTEDDICT INVERTEDDICTNAME) of dict]) (InvertedDict.Open - [LAMBDA (invertedDict) (* jtm%: " 7-Apr-87 09:01") + [LAMBDA (invertedDict) (* jtm%: " 7-Apr-87 09:01") (LET [(OPENFN (InvertedDict.Prop invertedDict 'OPENFN] (AND OPENFN (APPLY* OPENFN invertedDict]) ) @@ -1718,25 +1668,24 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989 by Xerox Corporation. All rights res (ADDTOVAR LAMA InvertedDict.Prop Dict.Prop Analyzer.Prop) ) -(PUTPROPS ANALYZER COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (10141 33876 (AnalyzerFromName 10151 . 11522) (Analyzer.CountWords 11524 . 12266) ( -Analyzer.DefaultCorrections 12268 . 19753) (Analyzer.DefaultNextWord 19755 . 21975) (Analyzer.Name -21977 . 22384) (Analyzer.DefaultAddEntry 22386 . 22896) (Analyzer.DefaultAnalyze 22898 . 28734) ( -Analyzer.DefaultProofread 28736 . 33874)) (33977 36948 (Analyzer.DefaultLoadWordList 33987 . 34397) ( -Analyzer.DefaultStoreWordList 34399 . 34975) (Analyzer.ReadWordList 34977 . 36038) ( -Analyzer.WriteWordList 36040 . 36361) (CREATEWORDLISTRDTBL 36363 . 36946)) (36980 38146 (Analyzer.Prop - 36990 . 37522) (Analyzer.PushProp 37524 . 38144)) (40472 41057 (STREAM.FETCHSTRING 40482 . 41055)) ( -42763 48941 (Analyzer.CorruptWord 42773 . 48939)) (49054 52044 (Analyzer.Establish 49064 . 49864) ( -AnalyzerForStream 49866 . 50101) (Analyzer.QuitFn 50103 . 50618) (Analyzer.BeforeLogout 50620 . 52042) -) (52045 69400 (TEdit.ProofreadMenu 52055 . 54471) (PROOFREADER.WHENSELECTEDFN 54473 . 54976) ( -WITH-TEDIT 54978 . 55882) (TEdit.Correct 55884 . 58740) (TEdit.CountWords 58742 . 59650) ( -TEdit.AddEntry 59652 . 60583) (TEdit.Proofread 60585 . 61433) (TEdit.SetAnalyzer 61435 . 63680) ( -TEdit.LoadWordList 63682 . 64427) (TEdit.StoreWordList 64429 . 65858) (Analyzer.TEditMenuItems 65860 - . 69398)) (72647 76175 (DictFromName 72657 . 74663) (Dict.Establish 74665 . 75318) (Dict.Prop 75320 - . 75814) (Dict.Name 75816 . 76173)) (76323 82812 (SimpleDict.New 76333 . 76705) (SimpleDict.PutEntry -76707 . 78907) (SimpleDict.Lookup 78909 . 81109) (SimpleDict.MapEntries 81111 . 81815) ( -SimpleDict.PrintEntries 81817 . 82348) (SimpleDict.Test 82350 . 82810)) (83131 86330 ( -InvertedDictFromName 83141 . 84639) (InvertedDict.Establish 84641 . 85146) (InvertedDict.Prop 85148 . -85682) (InvertedDict.Name 85684 . 86097) (InvertedDict.Open 86099 . 86328))))) + (FILEMAP (NIL (9372 32273 (AnalyzerFromName 9382 . 10454) (Analyzer.CountWords 10456 . 11198) ( +Analyzer.DefaultCorrections 11200 . 18136) (Analyzer.DefaultNextWord 18138 . 20216) (Analyzer.Name +20218 . 20625) (Analyzer.DefaultAddEntry 20627 . 21137) (Analyzer.DefaultAnalyze 21139 . 27240) ( +Analyzer.DefaultProofread 27242 . 32271)) (32374 35540 (Analyzer.DefaultLoadWordList 32384 . 32794) ( +Analyzer.DefaultStoreWordList 32796 . 33372) (Analyzer.ReadWordList 33374 . 34654) ( +Analyzer.WriteWordList 34656 . 34977) (CREATEWORDLISTRDTBL 34979 . 35538)) (35572 36735 (Analyzer.Prop + 35582 . 36113) (Analyzer.PushProp 36115 . 36733)) (38781 39366 (STREAM.FETCHSTRING 38791 . 39364)) ( +40872 46609 (Analyzer.CorruptWord 40882 . 46607)) (46722 49652 (Analyzer.Establish 46732 . 47585) ( +AnalyzerForStream 47587 . 47822) (Analyzer.QuitFn 47824 . 48339) (Analyzer.BeforeLogout 48341 . 49650) +) (49653 67173 (TEdit.ProofreadMenu 49663 . 52169) (PROOFREADER.WHENSELECTEDFN 52171 . 52678) ( +WITH-TEDIT 52680 . 53584) (TEdit.Correct 53586 . 56523) (TEdit.CountWords 56525 . 57433) ( +TEdit.AddEntry 57435 . 58366) (TEdit.Proofread 58368 . 59216) (TEdit.SetAnalyzer 59218 . 61451) ( +TEdit.LoadWordList 61453 . 62198) (TEdit.StoreWordList 62200 . 63631) (Analyzer.TEditMenuItems 63633 + . 67171)) (70206 73226 (DictFromName 70216 . 71890) (Dict.Establish 71892 . 72370) (Dict.Prop 72372 + . 72865) (Dict.Name 72867 . 73224)) (73374 78825 (SimpleDict.New 73384 . 73756) (SimpleDict.PutEntry +73758 . 75566) (SimpleDict.Lookup 75568 . 77139) (SimpleDict.MapEntries 77141 . 77828) ( +SimpleDict.PrintEntries 77830 . 78361) (SimpleDict.Test 78363 . 78823)) (79140 81952 ( +InvertedDictFromName 79150 . 80325) (InvertedDict.Establish 80327 . 80769) (InvertedDict.Prop 80771 . +81304) (InvertedDict.Name 81306 . 81719) (InvertedDict.Open 81721 . 81950))))) STOP diff --git a/lispusers/proofreader/PROOFREADER-ANALYZER.LCOM b/lispusers/proofreader/PROOFREADER-ANALYZER.LCOM new file mode 100644 index 000000000..ca439d0a1 Binary files /dev/null and b/lispusers/proofreader/PROOFREADER-ANALYZER.LCOM differ diff --git a/lispusers/ANALYZER.TEDIT b/lispusers/proofreader/PROOFREADER-ANALYZER.TEDIT similarity index 100% rename from lispusers/ANALYZER.TEDIT rename to lispusers/proofreader/PROOFREADER-ANALYZER.TEDIT diff --git a/lispusers/proofreader/PROOFREADER-DICTTOOL b/lispusers/proofreader/PROOFREADER-DICTTOOL new file mode 100644 index 000000000..c22e89d00 --- /dev/null +++ b/lispusers/proofreader/PROOFREADER-DICTTOOL @@ -0,0 +1,570 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "21-Jul-2025 23:17:10" {WMEDLEY}proofreader>PROOFREADER-DICTTOOL.;6 29526 + + :EDIT-BY rmk) + + +(PRETTYCOMPRINT PROOFREADER-DICTTOOLCOMS) + +(RPAQQ PROOFREADER-DICTTOOLCOMS + [(FILES PROOFREADER-ANALYZER SPELLINGARRAY) + (FNS Proofreader.New Proofreader.Open Proofreader.AddEntry Proofreader.Lookup + Proofreader.AllForms) + (FNS Proofreader.CharTable Proofreader.LookupBit Proofreader.SetBit) + (FNS Proofreader.Correct Proofreader.NextWord) + (MACROS Proofreader.Hash1 Proofreader.Hash2 \Proofreader.TestCorruption) + (INITVARS Proofreader Proofreader.AutoLoad Proofreader.Lisp) + (* Proofreader.AutoLoad is a file or list of files to be loaded whenever a proofreader is + opened.) + (P (Analyzer.Establish (SETQ Proofreader (Proofreader.New 'Proofreader]) + +(FILESLOAD PROOFREADER-ANALYZER SPELLINGARRAY) +(DEFINEQ + +(Proofreader.New + [LAMBDA (name fileName) (* jtm%: "13-Oct-87 11:57") + (PROG [(analyzer (create Morphalyzer + analyzerName _ name + openFn _ (FUNCTION Proofreader.Open) + lookupFn _ (FUNCTION Proofreader.Lookup) + addEntryFn _ (FUNCTION Proofreader.AddEntry] + (RETURN analyzer]) + +(Proofreader.Open + [LAMBDA (analyzer stream) (* jtm%: " 6-Feb-87 15:24") + (COND + ((NULL (fetch (Morphalyzer index) of analyzer)) + [replace (Morphalyzer index) of analyzer + with (PROG [(file (Analyzer.Prop analyzer 'FileName] + [COND + ((AND (NULL SpellingArray) + (NULL file)) + (ERROR "No Spelling Array for" analyzer)) + ((NULL SpellingArray) + (COND + ((NULL stream) + (PROMPTPRINT "initializing Proofreader")) + (T (TEDIT.PROMPTPRINT stream "initializing Proofreader" T))) + (RESETLST + (PROG (LENGTH ALENGTH BLOCK STREAM (START 0) + (HEADERSIZE 6)) + [RESETSAVE (SETQ STREAM (OPENSTREAM file 'INPUT 'OLD)) + '(PROGN (CLOSEF OLDVALUE] + (SETQ LENGTH (IDIFFERENCE (GETFILEINFO file 'LENGTH) + (IPLUS HEADERSIZE 2))) + (for i from 1 to HEADERSIZE do (BIN STREAM)) + (* skip header) + (while (ILESSP START LENGTH) + do (SETQ ALENGTH (MIN 64000 (IDIFFERENCE LENGTH START))) + (SETQ BLOCK (\ALLOCBLOCK (LRSH (IPLUS 3 ALENGTH) + 2))) + (\BINS STREAM BLOCK 0 ALENGTH) + (add START ALENGTH) + (push SpellingArray (CONS START BLOCK))) + (SETQ SpellingArray (REVERSE SpellingArray))))] + (RETURN (CONS SpellingArray (Proofreader.CharTable] + (for file inside Proofreader.AutoLoad do (Analyzer.DefaultLoadWordList analyzer file]) + +(Proofreader.AddEntry + [LAMBDA (analyzer lemma entry dontRecord) (* jtm%: " 6-Feb-87 15:24") + + (* * adds "lemma" to the SpellingArray. This procedure is just like Lookup, only + it sets the bits rather than just reading them.) + + (PROG (char p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 hashArray + hashArray.CharTable start length) (* first save the word on a property + list.) + (COND + ((NULL dontRecord) + (Analyzer.PushProp analyzer 'WordList lemma))) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer)) + [COND + ((NULL entry) + (SETQ entry (Proofreader.AllForms lemma] + [COND + ((NULL hashArray) + (Proofreader.Open analyzer) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer] + (SETQ hashArray.CharTable (CDR hashArray)) + (SETQ hashArray (CAR hashArray)) + (SETQ hash1 953) + (SETQ hash2 63869) + (SETQ hash3 2441) + (SETQ hash4 62265) + (SETQ hash5 4079) + (SETQ hash6 60585) + (SETQ hash7 5807) + (SETQ p 359) + (Stream.Init lemma start length) + (while (SETQ char (Stream.NextChar lemma length start)) + do [COND + ((ALPHACHARP char) + (SETQ char (ELT hashArray.CharTable (IDIFFERENCE char 64] + (add p 1009) + (SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash2)) + p))) + [SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2 hash3) + char] + [SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4) + char] + (SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2 hash5)) + p))) + (SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash6)) + p))) + (SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2 hash7) + char) + p))) + [SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1 hash1) + char] + (SETQ hash1 x1) + (SETQ hash2 x2) + (SETQ hash3 x3) + (SETQ hash4 x4) + (SETQ hash5 x5) + (SETQ hash6 x6) + (SETQ hash7 x7)) + + (* * set the bits.) + + (Proofreader.SetBit hash1 hash7 hashArray) + (Proofreader.SetBit hash2 hash6 hashArray) + (Proofreader.SetBit hash3 hash5 hashArray) + (Proofreader.SetBit hash4 hash4 hashArray) + (Proofreader.SetBit hash5 hash3 hashArray) + (Proofreader.SetBit hash6 hash2 hashArray) + (Proofreader.SetBit hash7 hash1 hashArray) + (RETURN lemma]) + +(Proofreader.Lookup + [LAMBDA (analyzer stream start length) (* jtm%: " 6-Feb-87 15:25") + + (* * hashes the string into the array using a probabalistic technique. + This may produce a false positive.) + + (PROG (char word p x1 x2 x3 x4 x5 x6 x7 hash1 hash2 hash3 hash4 hash5 hash6 hash7 hashArray + hashArray.CharTable) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer)) + [COND + ((NULL hashArray) + (Proofreader.Open analyzer) + (SETQ hashArray (fetch (Morphalyzer index) of analyzer] + (SETQ hashArray.CharTable (CDR hashArray)) + (SETQ hashArray (CAR hashArray)) + (SETQ hash1 953) + (SETQ hash2 63869) + (SETQ hash3 2441) + (SETQ hash4 62265) + (SETQ hash5 4079) + (SETQ hash6 60585) + (SETQ hash7 5807) + (SETQ p 359) + (Stream.Init stream start length) + (while (SETQ char (Stream.NextChar stream length start)) + do [COND + ((IGREATERP char 255) + (SETQ char (IMOD char 256] + [COND + ((ALPHACHARP char) + (SETQ char (ELT hashArray.CharTable (IDIFFERENCE char 64] + (add p 1009) + (SETQ x1 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash2)) + p))) + [SETQ x2 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash2 hash3) + char] + [SETQ x3 (LOGAND 65535 (LOGXOR p (IDIFFERENCE (Proofreader.Hash1 hash4) + char] + (SETQ x4 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE char (Proofreader.Hash2 hash5)) + p))) + (SETQ x5 (LOGAND 65535 (IDIFFERENCE (LOGXOR char (Proofreader.Hash1 hash6)) + p))) + (SETQ x6 (LOGAND 65535 (IDIFFERENCE (IDIFFERENCE (Proofreader.Hash2 hash7) + char) + p))) + [SETQ x7 (LOGAND 65535 (IDIFFERENCE p (IDIFFERENCE (Proofreader.Hash1 hash1) + char] + (SETQ hash1 x1) + (SETQ hash2 x2) + (SETQ hash3 x3) + (SETQ hash4 x4) + (SETQ hash5 x5) + (SETQ hash6 x6) + (SETQ hash7 x7)) + (COND + ((AND (Proofreader.LookupBit hash1 hash7 hashArray) + (Proofreader.LookupBit hash2 hash6 hashArray) + (Proofreader.LookupBit hash3 hash5 hashArray) + (Proofreader.LookupBit hash4 hash4 hashArray) + (Proofreader.LookupBit hash5 hash3 hashArray) + (Proofreader.LookupBit hash6 hash2 hashArray) + (Proofreader.LookupBit hash7 hash1 hashArray)) + (RETURN T]) + +(Proofreader.AllForms + [LAMBDA (lemma) (* jtm%: " 6-Feb-87 15:25") + + (* * ask the user for the forms to fill out this word.) + + (PROG (forms form newForms menuPos) + (SETQ forms (LIST 'NOUN 'VERB 'ADJ (English.Suffix lemma "s") + (English.Suffix lemma "s") + (English.Suffix lemma "er") + " " + (English.Suffix lemma "ed") + (English.Suffix lemma "est") + " " + (English.Suffix lemma "ing") + " " " " '*OTHER*)) + (while [SETQ form + (MENU (create MENU + TITLE _ "parts of speech" + CENTERFLG _ T + ITEMS _ forms + MENUCOLUMNS _ 3 + CHANGEOFFSETFLG _ T + MENUPOSITION _ (COND + (menuPos) + (T (GETMOUSESTATE) + (SETQ menuPos (CONS LASTMOUSEX LASTMOUSEY] + do (pushnew newForms form)) + (RETURN newForms]) +) +(DEFINEQ + +(Proofreader.CharTable + [LAMBDA NIL (* jtm%: " 6-Feb-87 15:27") + + (* * comment) + + (PROG (SpellingArray.CharTable) + (SETQ SpellingArray.CharTable (ARRAY 58)) + (for i in '(0 32) do (SETA SpellingArray.CharTable (IPLUS i 1) + 65325) + (SETA SpellingArray.CharTable (IPLUS i 2) + 65204) + (SETA SpellingArray.CharTable (IPLUS i 3) + 449) + (SETA SpellingArray.CharTable (IPLUS i 4) + 588) + (SETA SpellingArray.CharTable (IPLUS i 5) + 7102) + (SETA SpellingArray.CharTable (IPLUS i 6) + 64682) + (SETA SpellingArray.CharTable (IPLUS i 7) + 64545) + (SETA SpellingArray.CharTable (IPLUS i 8) + 64418) + (SETA SpellingArray.CharTable (IPLUS i 9) + 1278) + (SETA SpellingArray.CharTable (IPLUS i 10) + 1433) + (SETA SpellingArray.CharTable (IPLUS i 11) + 63968) + (SETA SpellingArray.CharTable (IPLUS i 12) + 63827) + (SETA SpellingArray.CharTable (IPLUS i 13) + 1874) + (SETA SpellingArray.CharTable (IPLUS i 14) + 2027) + (SETA SpellingArray.CharTable (IPLUS i 15) + 2180) + (SETA SpellingArray.CharTable (IPLUS i 16) + 63195) + (SETA SpellingArray.CharTable (IPLUS i 17) + 63058) + (SETA SpellingArray.CharTable (IPLUS i 18) + 62865) + (SETA SpellingArray.CharTable (IPLUS i 19) + 2798) + (SETA SpellingArray.CharTable (IPLUS i 20) + 2963) + (SETA SpellingArray.CharTable (IPLUS i 21) + 62372) + (SETA SpellingArray.CharTable (IPLUS i 22) + 62216) + (SETA SpellingArray.CharTable (IPLUS i 23) + 62067) + (SETA SpellingArray.CharTable (IPLUS i 24) + 3624) + (SETA SpellingArray.CharTable (IPLUS i 25) + 3793) + (SETA SpellingArray.CharTable (IPLUS i 26) + 3944)) + (RETURN SpellingArray.CharTable]) + +(Proofreader.LookupBit + [LAMBDA (row column SpellingArray) (* jtm%: " 6-Feb-87 15:27") + + (* * There are 4096 bits per row, but only 4093 of them are used.) + + (PROG (byte (startByte 0)) + (SETQ row (IMOD row 199)) + (SETQ column (IMOD column 4093)) + (SETQ byte (IPLUS (LLSH row 9) + (LRSH column 3))) + (for block in SpellingArray do (COND + ((ILESSP byte (CAR block)) + (SETQ byte (\GETBASEBYTE (CDR block) + (IDIFFERENCE byte startByte))) + (RETURN))) + (SETQ startByte (CAR block))) + (RETURN (BITTEST byte (MASK.1'S (IDIFFERENCE 7 (LOGAND column 7)) + 1]) + +(Proofreader.SetBit + [LAMBDA (row column SpellingArray) (* jtm%: " 6-Feb-87 15:28") + + (* * There are 4096 bits per row, but only 4093 of them are used.) + + (PROG (address (startByte 0)) + (SETQ row (IMOD row 199)) + (SETQ column (IMOD column 4093)) + (SETQ address (IPLUS (LLSH row 9) + (LRSH column 3))) + (for block byte in SpellingArray do (COND + ((ILESSP address (CAR block)) + (SETQ byte (\GETBASEBYTE (CDR block) + (IDIFFERENCE address startByte))) + (SETQ byte (BITSET byte + (MASK.1'S (IDIFFERENCE + 7 + (LOGAND column 7)) + 1))) + (\PUTBASEBYTE (CDR block) + (IDIFFERENCE address startByte) + byte) + (RETURN))) + (SETQ startByte (CAR block]) +) +(DEFINEQ + +(Proofreader.Correct + [LAMBDA (analyzer stream start length) (* jtm%: " 6-Feb-87 15:28") + + (* * returns a list of possible spelling corrections for the given word.) + + (PROG (form word wordList caps periods) + [COND + ((NOT (LISTP stream)) + (SETFILEPTR stream start) + (SETQ word (for i from 1 to length collect (READC stream] + (SETQ caps (Analyzer.Capitalization word)) + (SETQ periods (FMEMB '%. word)) + + (* * first try transpositions) + + (for tail temp on word while (CDR tail) do (SETQ temp (CAR tail)) + (RPLACA tail (CADR tail)) + (RPLACA (CDR tail) + temp) + (COND + ((AND (EQ caps 'FIRST) + (EQ tail word)) + (* don't transpose the first letters + of a capitalized word.) + NIL) + (T (\Proofreader.TestCorruption analyzer word + wordList))) + (RPLACA (CDR tail) + (CAR tail)) + (RPLACA tail temp)) + + (* * next try deletions) + + (COND + ((CDR word) + (\Proofreader.TestCorruption analyzer (CDR word) + wordList))) + (for tail temp on word while (CDR tail) do (SETQ temp (CDR tail)) + (RPLACD tail (CDDR tail)) + (\Proofreader.TestCorruption analyzer word + wordList) + (RPLACD tail temp)) + + (* * prepend a character.) + + (SETQ word (CONS 'A word)) + (SELECTQ caps + (FIRST (* don't prepend a character before a + capitalized word.) + NIL) + (ALL (* prepend a capital letter.) + (for c from (CHARCODE A) to (CHARCODE Z) do (RPLACA word (CHARACTER c)) + (\Proofreader.TestCorruption analyzer + word wordList))) + (for c from (CHARCODE a) to (CHARCODE z) do (RPLACA word (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word + wordList))) + (SETQ word (CDR word)) + + (* * insert characters.) + + (for tail on word do (RPLACD tail (CONS 'A (CDR tail))) + [COND + ((EQ caps 'ALL) + (for c from (CHARCODE A) to (CHARCODE Z) + do (RPLACA (CDR tail) + (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList))) + (T (for c from (CHARCODE a) to (CHARCODE z) + do (RPLACA (CDR tail) + (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList] + (COND + (periods (RPLACA (CDR tail) + '%.) + (\Proofreader.TestCorruption analyzer word wordList))) + (RPLACD tail (CDDR tail))) + + (* * replace characters) + + (for tail temp on word do (SETQ temp (CAR tail)) + [COND + ((OR (EQ caps 'ALL) + (AND (EQ caps 'FIRST) + (EQ tail word))) + (for c from (CHARCODE A) to (CHARCODE Z) + do (COND + ((NEQ temp (CHARACTER c)) + (RPLACA tail (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList + ] + [COND + ((OR (EQ caps NIL) + (NOT (ALPHACHARP (CHCON1 temp))) + (AND (EQ caps 'FIRST) + (NEQ tail word))) + (for c from (CHARCODE a) to (CHARCODE z) + do (COND + ((NEQ temp (CHARACTER c)) + (RPLACA tail (CHARACTER c)) + (\Proofreader.TestCorruption analyzer word wordList + ] + (COND + (periods (RPLACA tail '%.) + (\Proofreader.TestCorruption analyzer word wordList))) + (RPLACA tail temp)) + (SETQ wordList (SORT wordList)) + [for i on wordList do (while (STREQUAL (CAR i) + (CADR i)) do (RPLACD i (CDDR i] + (RETURN wordList]) + +(Proofreader.NextWord + [LAMBDA (analyzer stream startPtr searchLength NWFn) (* jtm%: " 6-Feb-87 15:29") + + (* * Scans the stream looking for a word, i.e. + a sequence of alphabetic charqacters. If the file ptr is already in the middle of + such a sequence, it backs up to the beginning of that sequence. + The function applies NWFn to (stream start stop) for each such word.) + + (SETFILEPTR stream (OR startPtr (SETQ startPtr 0))) + (bind char end endPtr word length start value quote period number (filePtr _ (GETFILEPTR stream)) + (EOFPtr _ (GETEOFPTR stream)) first (SETQ endPtr (COND + (searchLength (IMIN EOFPtr + (IPLUS startPtr + searchLength + ))) + (T EOFPtr))) + do (SETQ char (AND (ILESSP (GETFILEPTR stream) + endPtr) + (BIN stream))) + (COND + [(AND char (AND (NUMBERP char) + (ILESSP char 128) + (Analyzer.AlphaCharP char))) + [OR start (SETQ start (SUB1 (GETFILEPTR stream] + (COND + (number + + (* we have a number followed by some characters. + (e.g. 7th, 21st, etc.) Take in the last digit of the number.) + + (add start -1) + (SETQ number NIL))) + (COND + (quote (COND + ((EQ quote T) (* don't make a list until you need + to.) + (SETQ quote NIL))) + (push quote char))) + (COND + (period (COND + ((EQ period T) + (SETQ period NIL))) + (push period char] + ((AND start char (EQUAL char (CHARCODE %'))) (* if the quote is in the middle of a + word, leave it in.) + (SETQ quote T)) + ((AND start char (EQUAL char (CHARCODE %.))) (* look for e.g., i.e.) + (OR period (SETQ period T))) + (start (SETQ end (GETFILEPTR stream)) + (SETQ length (IDIFFERENCE end start)) + (AND char (add length -1)) (* back up to the last legal char.) + (COND + ((EQ quote T) (* delete final quotes) + (add length -1)) + ([OR (EQUAL quote '(115)) + (EQUAL quote '(83] (* delete %'s) + (add length -2))) + (SETQ quote NIL) + (COND + ((EQ period T) (* delete final periods) + (add length -1))) + (SETQ period NIL) + (COND + ((AND (EQ length 1) + (EQ char (CHARCODE %)))) (* letters used for outlines.) + (add length 1))) + [COND + [NWFn (SETQ value (APPLY* NWFn analyzer stream start length)) + (COND + ((EQ value T) + (RETURN (CONS start length))) + (value (RETURN value] + (T (RETURN (CONS start length] + (SETFILEPTR stream end) + (SETQ start NIL)) + ((AND char (NUMBERP char) + (IGEQ char 48) + (ILEQ char 57)) (* a number) + (SETQ number char)) + (T (SETQ number NIL))) + (OR char (RETURN]) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS Proofreader.Hash1 MACRO ((X) + (IPLUS (LLSH (LOGAND X 2047) + 5) + (LRSH X 11)))) + +(PUTPROPS Proofreader.Hash2 MACRO ((X) + (IPLUS (LLSH (LOGAND X 8191) + 3) + (LRSH X 13)))) + +(PUTPROPS \Proofreader.TestCorruption MACRO [(analyzer word wordList) + (COND + ((Proofreader.Lookup analyzer word NIL NIL) + (push wordList (CONCATLIST word]) +) + +(RPAQ? Proofreader NIL) + +(RPAQ? Proofreader.AutoLoad NIL) + +(RPAQ? Proofreader.Lisp NIL) + + + +(* Proofreader.AutoLoad is a file or list of files to be loaded whenever a proofreader is opened.) + + +[Analyzer.Establish (SETQ Proofreader (Proofreader.New 'Proofreader] +(DECLARE%: DONTCOPY + (FILEMAP (NIL (984 11719 (Proofreader.New 994 . 1436) (Proofreader.Open 1438 . 3736) ( +Proofreader.AddEntry 3738 . 7140) (Proofreader.Lookup 7142 . 10352) (Proofreader.AllForms 10354 . +11717)) (11720 17547 (Proofreader.CharTable 11730 . 15067) (Proofreader.LookupBit 15069 . 16019) ( +Proofreader.SetBit 16021 . 17545)) (17548 28441 (Proofreader.Correct 17558 . 24124) ( +Proofreader.NextWord 24126 . 28439))))) +STOP diff --git a/lispusers/proofreader/PROOFREADER-DICTTOOL.LCOM b/lispusers/proofreader/PROOFREADER-DICTTOOL.LCOM new file mode 100644 index 000000000..6f0e5d0dd Binary files /dev/null and b/lispusers/proofreader/PROOFREADER-DICTTOOL.LCOM differ diff --git a/lispusers/DICTTOOL.TEDIT b/lispusers/proofreader/PROOFREADER-DICTTOOL.TEDIT similarity index 100% rename from lispusers/DICTTOOL.TEDIT rename to lispusers/proofreader/PROOFREADER-DICTTOOL.TEDIT diff --git a/lispusers/PROOFREADER.TEDIT b/lispusers/proofreader/PROOFREADER-PROOFREADER.TEDIT similarity index 100% rename from lispusers/PROOFREADER.TEDIT rename to lispusers/proofreader/PROOFREADER-PROOFREADER.TEDIT diff --git a/lispusers/proofreader/PROOFREADER-SPELLINGARRAY b/lispusers/proofreader/PROOFREADER-SPELLINGARRAY new file mode 100644 index 000000000..3d04744ca Binary files /dev/null and b/lispusers/proofreader/PROOFREADER-SPELLINGARRAY differ diff --git a/lispusers/WORDNERD b/lispusers/proofreader/PROOFREADER-WORDNERD similarity index 58% rename from lispusers/WORDNERD rename to lispusers/proofreader/PROOFREADER-WORDNERD index efb0b11d7..a11cdde94 100644 --- a/lispusers/WORDNERD +++ b/lispusers/proofreader/PROOFREADER-WORDNERD @@ -1,22 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Nov-88 10:52:55" {ERINYES}MEDLEY>WORDNERD.;1 82616 - changes to%: (FNS WordNerd.DefaultVennSearch WordNerd.DefaultWeightedSearch - HashfileNerd.ExpandKeyPattern HashfileNerd.MapKeys HashfileNerd.Create) - (VARS WORDNERDCOMS) - (MACROS WordNerd.ExpandKeyPattern) - (RECORDS WNKEYSETINFO WNKEYINFO) +(FILECREATED "21-Jul-2025 23:18:13" {WMEDLEY}proofreader>PROOFREADER-WORDNERD.;3 77975 - previous date%: "11-Nov-88 17:23:39" {QV}LISP>WORDNERD.;24) + :EDIT-BY rmk) -(* " -Copyright (c) 1988 by Xerox Corporation. All rights reserved. -") +(PRETTYCOMPRINT PROOFREADER-WORDNERDCOMS) -(PRETTYCOMPRINT WORDNERDCOMS) - -(RPAQQ WORDNERDCOMS +(RPAQQ PROOFREADER-WORDNERDCOMS ((* * The following macros are the interface to three different search techniques using a WordNerd. The default implementations are given below.) (MACROS WordNerd.Open WordNerd.Close WordNerd.AddAssociation WordNerd.MapKeys @@ -45,60 +36,55 @@ Copyright (c) 1988 by Xerox Corporation. All rights reserved. (FNS SimpleAnalyzer.Create SimpleAnalyzer.Lookup) (FNS SimpleDict.Create SimpleDict.Open SimpleDict.Close SimpleDict.Write)) (VARS ENGLISHSTOPWORDS))) - (* * The following macros are the interface to three different search techniques using a WordNerd. -The default implementations are given below.) + (* * The following macros are the interface to three different search techniques using a WordNerd. The + default implementations are given below.) (DECLARE%: EVAL@COMPILE (PUTPROPS WordNerd.Open MACRO ((WORDNERD) - (APPLY* (OR (InvertedDict.Prop WORDNERD 'OPENFN) - (FUNCTION NILL)) - WORDNERD))) + (APPLY* (OR (InvertedDict.Prop WORDNERD 'OPENFN) + (FUNCTION NILL)) + WORDNERD))) (PUTPROPS WordNerd.Close MACRO ((WORDNERD) - (APPLY* (OR (InvertedDict.Prop WORDNERD 'CLOSEFN) - (FUNCTION NILL)) - WORDNERD))) + (APPLY* (OR (InvertedDict.Prop WORDNERD 'CLOSEFN) + (FUNCTION NILL)) + WORDNERD))) (PUTPROPS WordNerd.AddAssociation MACRO ((WORDNERD HEADER KEY) - (APPLY* (InvertedDict.Prop WORDNERD - 'ADDASSOCIATIONFN) - WORDNERD HEADER KEY))) + (APPLY* (InvertedDict.Prop WORDNERD 'ADDASSOCIATIONFN) + WORDNERD HEADER KEY))) (PUTPROPS WordNerd.MapKeys MACRO ((WORDNERD MAPFN) - (APPLY* (OR (InvertedDict.Prop WORDNERD 'MAPKEYSFN) - (FUNCTION NILL)) - WORDNERD MAPFN))) + (APPLY* (OR (InvertedDict.Prop WORDNERD 'MAPKEYSFN) + (FUNCTION NILL)) + WORDNERD MAPFN))) (PUTPROPS WordNerd.ExpandKeyPattern MACRO ((WORDNERD KEYPATTERN) - (APPLY* (OR (InvertedDict.Prop WORDNERD - 'EXPANDKEYPATTERNFN) - (FUNCTION NILL)) - WORDNERD KEYPATTERN))) + (APPLY* (OR (InvertedDict.Prop WORDNERD + 'EXPANDKEYPATTERNFN) + (FUNCTION NILL)) + WORDNERD KEYPATTERN))) -(PUTPROPS WordNerd.VennSearch MACRO ((WORDNERD SYNONYMCLASSES MINKEYWORDS MINWORD MAXWORD - DONTCONVERT) - (APPLY* (InvertedDict.Prop WORDNERD 'VENNSEARCHFN) - WORDNERD SYNONYMCLASSES MINKEYWORDS MINWORD - MAXWORD DONTCONVERT))) +(PUTPROPS WordNerd.VennSearch MACRO ((WORDNERD SYNONYMCLASSES MINKEYWORDS MINWORD MAXWORD DONTCONVERT + ) + (APPLY* (InvertedDict.Prop WORDNERD 'VENNSEARCHFN) + WORDNERD SYNONYMCLASSES MINKEYWORDS MINWORD MAXWORD + DONTCONVERT))) (PUTPROPS WordNerd.RelevanceSearch MACRO ((WORDNERD HEADERS KEYSTOIGNORE MINWORD MAXWORD) - (APPLY* (InvertedDict.Prop WORDNERD - 'RELEVANCESEARCHFN) - WORDNERD HEADERS KEYSTOIGNORE MINWORD - MAXWORD))) - -(PUTPROPS WordNerd.WeightedSearch MACRO ((WORDNERD WEIGHTEDKEYS MINWORD MAXWORD - USEFREQWEIGHTS) - (APPLY* (InvertedDict.Prop WORDNERD - 'WEIGHTEDSEARCHFN) - WORDNERD WEIGHTEDKEYS MINWORD MAXWORD - USEFREQWEIGHTS))) + (APPLY* (InvertedDict.Prop WORDNERD 'RELEVANCESEARCHFN) + WORDNERD HEADERS KEYSTOIGNORE MINWORD MAXWORD))) + +(PUTPROPS WordNerd.WeightedSearch MACRO ((WORDNERD WEIGHTEDKEYS MINWORD MAXWORD USEFREQWEIGHTS) + (APPLY* (InvertedDict.Prop WORDNERD 'WEIGHTEDSEARCHFN) + WORDNERD WEIGHTEDKEYS MINWORD MAXWORD USEFREQWEIGHTS) + )) ) (DEFINEQ (WordNerd.AddEntry - [LAMBDA (WORDNERD HEADER ENTRY ANALYZER) (* ; "Edited 14-Sep-88 09:25 by jtm:") + [LAMBDA (WORDNERD HEADER ENTRY ANALYZER) (* ; "Edited 14-Sep-88 09:25 by jtm:") (LET (ADDASSOCFN) [COND ((NULL ANALYZER) @@ -113,7 +99,7 @@ The default implementations are given below.) NIL]) (WordNerd.AddDictionary - [LAMBDA (WORDNERD DICTIONARY ANALYZER) (* ; "Edited 14-Sep-88 10:11 by jtm:") + [LAMBDA (WORDNERD DICTIONARY ANALYZER) (* ; "Edited 14-Sep-88 10:11 by jtm:") [COND ((NULL ANALYZER) (SETQ ANALYZER (InvertedDict.Prop WORDNERD 'ANALYZER] @@ -121,21 +107,20 @@ The default implementations are given below.) [(EQ (FUNCTION SimpleDict.MapEntries) (fetch (Dict mapFn) of DICTIONARY)) (* this is a hack until we fix - SimpleDict.MapEntries) + SimpleDict.MapEntries) (FUNCTION (LAMBDA (DICT HEADER ENTRY) (WordNerd.AddEntry WORDNERD (CONCATLIST HEADER) ENTRY ANALYZER] (T (FUNCTION (LAMBDA (DICT HEADER ENTRY) - (WordNerd.AddEntry WORDNERD HEADER ENTRY - ANALYZER]) + (WordNerd.AddEntry WORDNERD HEADER ENTRY ANALYZER]) (WordNerd.AddStopWords - [LAMBDA (WORDNERD STOPWORDS) (* ; "Edited 15-Sep-88 17:12 by jtm:") + [LAMBDA (WORDNERD STOPWORDS) (* ; "Edited 15-Sep-88 17:12 by jtm:") (for WORD inside STOPWORDS do (WordNerd.AddAssociation WORDNERD :STOPWORD WORD)) WORDNERD]) (WordNerd.SortByFrequency - [LAMBDA (WORDNERD MINCOUNT) (* ; "Edited 25-Oct-88 13:34 by jtm:") + [LAMBDA (WORDNERD MINCOUNT) (* ; "Edited 25-Oct-88 13:34 by jtm:") (LET (ENTRIES) [WordNerd.MapKeys WORDNERD (FUNCTION (LAMBDA (NERD KEYWORD KEYID ASSOCS) (DECLARE (SPECVARS MINCOUNT)) @@ -189,56 +174,54 @@ The default implementations are given below.) (SETQ ExpandKeyPatternFn (InvertedDict.Prop wordNerd 'EXPANDKEYPATTERNFN)) (* ;; - "synonymClasses is a list of lists of words, where each sub-list represents a class of synonyms") + "synonymClasses is a list of lists of words, where each sub-list represents a class of synonyms") [for synonymClass wordList inside synonymClasses do (SETQ wordList NIL) - (* ;; "build wordlist, a concatenation of the entries in the synonym class") - - [for pattern inside synonymClass - do (for word word# entry - inside (OR (AND ExpandKeyPatternFn (STRPOS '* pattern) - (APPLY* ExpandKeyPatternFn wordNerd pattern)) - pattern) - do (COND - [[SETQ word# (COND - ((OR (NUMBERP word) - (NULL GetKeyIDFn)) - word) - (T (APPLY* GetKeyIDFn wordNerd word keyIndex - ] - (SETQ entry (APPLY* GetEntryFn wordNerd word# indexFile)) - (COND - ((OR (EQ entry :STOPWORD) - (EQ -1 (CAR entry))) - (SETQ entry NIL))) - (SETQ wordList (COND - ((LISTP synonymClass) + (* ;; "build wordlist, a concatenation of the entries in the synonym class") + + [for pattern inside synonymClass + do (for word word# entry inside (OR (AND ExpandKeyPatternFn (STRPOS '* pattern) + (APPLY* ExpandKeyPatternFn wordNerd + pattern)) + pattern) + do (COND + [[SETQ word# (COND + ((OR (NUMBERP word) + (NULL GetKeyIDFn)) + word) + (T (APPLY* GetKeyIDFn wordNerd word keyIndex] + (SETQ entry (APPLY* GetEntryFn wordNerd word# indexFile)) + (COND + ((OR (EQ entry :STOPWORD) + (EQ -1 (CAR entry))) + (SETQ entry NIL))) + (SETQ wordList (COND + ((LISTP synonymClass) (* ; - "NCONC would destructively modify the wordNerd's entry.") - (APPEND entry wordList)) - (T entry] - (T (push notFound (create WNKEYINFO - WNKEY _ (LIST (CONCAT word "?"] - (SETQ wordList (SORT wordList (FUNCTION ILESSP))) + "NCONC would destructively modify the wordNerd's entry.") + (APPEND entry wordList)) + (T entry] + (T (push notFound (create WNKEYINFO + WNKEY _ (LIST (CONCAT word "?"] + (SETQ wordList (SORT wordList (FUNCTION ILESSP))) (* ; - "SORT may modify the entry, but shouldn't be a problem.") - - (* ;; "add the word list to the list of key associations") - - (AND wordList (push keys (create WNKEYINFO - WNKEY _ (COND - [(LISTP synonymClass) - (COND - ((CDR synonymClass) - (CONCAT (CAR synonymClass) - "+")) - (T (CAR synonymClass] - (T synonymClass)) - WNKEYWEIGHT _ (IQUOTIENT 10000 (LENGTH wordList - )) - WNKEYDATA _ wordList] + "SORT may modify the entry, but shouldn't be a problem.") + + (* ;; "add the word list to the list of key associations") + + (AND wordList (push keys (create WNKEYINFO + WNKEY _ (COND + [(LISTP synonymClass) + (COND + ((CDR synonymClass) + (CONCAT (CAR synonymClass) + "+")) + (T (CAR synonymClass] + (T synonymClass)) + WNKEYWEIGHT _ (IQUOTIENT 10000 (LENGTH wordList)) + WNKEYDATA _ wordList] (SETQ keys (DREVERSE keys)) (* ;; "determine the minimum number of keys for a word to be included in the result") @@ -258,7 +241,7 @@ The default implementations are given below.) ((NULL minWord) (SETQ minWord 0)) ((EQ minWord 1) (* ; - "minWord = 0 allows notFound to be returned.") + "minWord = 0 allows notFound to be returned.") (SETQ minWord 0))) (COND ((OR (NULL maxWord) @@ -267,59 +250,53 @@ The default implementations are given below.) (* ;; "now skim the classes off of the top of the lists in alphabetical order, putting them in a Venn diagram") - [do (* ; - "find the lowest numbered entry in the word lists") - (SETQ first NIL) - [for keyInfo myFirst in keys do (SETQ myFirst - (CAR (fetch WNKEYDATA of keyInfo - ))) - (COND - ((OR (NULL first) - (AND myFirst (ILESSP myFirst first - ))) - (SETQ first myFirst] - (COND - ((NULL first) (* ; "all of the word lists are empty") - (RETURN)) - (T - (* ;; "make a list of all of the classes that have 'first' in their word list. Remove 'first' from the word lists") - - (SETQ keySet NIL) - (SETQ keySetWeight 0) - [for keyInfo myFirst myKey in keys - do (SETQ myKey (fetch WNKEY of keyInfo)) - (SETQ myFirst (CAR (fetch WNKEYDATA of keyInfo))) - (COND - ((AND myFirst (EQP first myFirst)) - (COND - ((NULL keySet) - (push keySet myKey)) - (T (NCONC1 keySet myKey))) - (add keySetWeight (fetch WNKEYWEIGHT of keyInfo)) + [do (* ; + "find the lowest numbered entry in the word lists") + (SETQ first NIL) + [for keyInfo myFirst in keys do (SETQ myFirst (CAR (fetch WNKEYDATA of keyInfo))) + (COND + ((OR (NULL first) + (AND myFirst (ILESSP myFirst first))) + (SETQ first myFirst] + (COND + ((NULL first) (* ; "all of the word lists are empty") + (RETURN)) + (T + (* ;; "make a list of all of the classes that have 'first' in their word list. Remove 'first' from the word lists") + + (SETQ keySet NIL) + (SETQ keySetWeight 0) + [for keyInfo myFirst myKey in keys + do (SETQ myKey (fetch WNKEY of keyInfo)) + (SETQ myFirst (CAR (fetch WNKEYDATA of keyInfo))) + (COND + ((AND myFirst (EQP first myFirst)) + (COND + ((NULL keySet) + (push keySet myKey)) + (T (NCONC1 keySet myKey))) + (add keySetWeight (fetch WNKEYWEIGHT of keyInfo)) - (* ;; "eliminate multiple entries") + (* ;; "eliminate multiple entries") - (while (AND (SETQ myFirst (CAR (fetch WNKEYDATA - of keyInfo))) - (EQP myFirst first)) - do (pop (fetch WNKEYDATA of keyInfo] + (while (AND (SETQ myFirst (CAR (fetch WNKEYDATA of keyInfo))) + (EQP myFirst first)) + do (pop (fetch WNKEYDATA of keyInfo] (* ; - "put 'first' in the appropriate venn diagram entry") - (COND - ((IGEQ (LENGTH keySet) - minKeywords) (* ; - "skip single classes if we were given multiple key classes") - (COND - ([NOT (SETQ keySetInfo (for set in venn - thereis (EQUAL keySet - (fetch WNKEY - of set] - (SETQ keySetInfo (create WNKEYINFO - WNKEY _ keySet - WNKEYWEIGHT _ keySetWeight)) - (push venn keySetInfo))) - (push (fetch WNKEYDATA of keySetInfo) - first] + "put 'first' in the appropriate venn diagram entry") + (COND + ((IGEQ (LENGTH keySet) + minKeywords) (* ; + "skip single classes if we were given multiple key classes") + (COND + ([NOT (SETQ keySetInfo (for set in venn + thereis (EQUAL keySet (fetch WNKEY of set] + (SETQ keySetInfo (create WNKEYINFO + WNKEY _ keySet + WNKEYWEIGHT _ keySetWeight)) + (push venn keySetInfo))) + (push (fetch WNKEYDATA of keySetInfo) + first] (* ;;; "sort the venn diagram so that the classes that are in the most overlaps come first") @@ -336,81 +313,73 @@ The default implementations are given below.) (SETQ priorSet NIL) (SETQ venn (NCONC notFound venn)) - [for tail keySet keySetLength overflow i (buffer _ (AND GetBufferFn - (APPLY* GetBufferFn wordNerd - headerIndex))) + [for tail keySet keySetLength overflow i (buffer _ (AND GetBufferFn (APPLY* GetBufferFn + wordNerd + headerIndex))) on venn do (SETQ overflow NIL) - (SETQ keySet (CAR tail)) - (SETQ keySetLength (LENGTH (fetch WNKEYDATA of keySet))) - (COND - [(IGEQ n maxWord) (* ; - "set is above maximum, remove from venn diagram") - (COND - [(EQ minWord 0) - (replace WNKEYDATA of keySet - with (LIST (CONCAT keySetLength " entries."] - (T (COND - (priorSet (RPLACD priorSet (CDR tail))) - (T (SETQ venn (CDR tail] - [(ILESSP (IPLUS n keySetLength) - minWord) (* ; - "set is below minimum, remove from venn diagram") - (add n keySetLength) - (COND - ((NULL (CDR tail)) - - (* ;; "if all of the sets are below minimum, leave the header for the last one so that the user knows what is going on.") - - (push (fetch WNKEY of keySet) - ". . .") - (replace WNKEYDATA of keySet with (LIST - "no more words." - ))) - (T (SETQ venn (CDR tail] - (T (* ; - "we want to include at least part of this set") - (SETQ priorSet tail) - (replace WNKEYDATA of keySet - with (DREVERSE (fetch WNKEYDATA of keySet))) - [for keyTail on (fetch WNKEYDATA of keySet) - do (add n 1) - (COND - ((AND (IGEQ n minWord) - (NOT dontConvert)) + (SETQ keySet (CAR tail)) + (SETQ keySetLength (LENGTH (fetch WNKEYDATA of keySet))) + (COND + [(IGEQ n maxWord) (* ; + "set is above maximum, remove from venn diagram") + (COND + [(EQ minWord 0) + (replace WNKEYDATA of keySet with (LIST (CONCAT keySetLength + " entries."] + (T (COND + (priorSet (RPLACD priorSet (CDR tail))) + (T (SETQ venn (CDR tail] + [(ILESSP (IPLUS n keySetLength) + minWord) (* ; + "set is below minimum, remove from venn diagram") + (add n keySetLength) + (COND + ((NULL (CDR tail)) + + (* ;; "if all of the sets are below minimum, leave the header for the last one so that the user knows what is going on.") + + (push (fetch WNKEY of keySet) + ". . .") + (replace WNKEYDATA of keySet with (LIST "no more words."))) + (T (SETQ venn (CDR tail] + (T (* ; + "we want to include at least part of this set") + (SETQ priorSet tail) + (replace WNKEYDATA of keySet with (DREVERSE (fetch WNKEYDATA + of keySet))) + [for keyTail on (fetch WNKEYDATA of keySet) + do (add n 1) + (COND + ((AND (IGEQ n minWord) + (NOT dontConvert)) (* ; "convert the number into a word") - (RPLACA keyTail (CONCAT (APPLY* GetHeaderFn wordNerd - (CAR keyTail) - headerIndex buffer))) - (* ; - "CONCAT will copy the string out of the buffer.") - (BLOCK))) - (COND - ((EQ n minWord) - (* ; - "remove the numbers before this one") - (replace WNKEYDATA of keySet with - keyTail) - (push (fetch WNKEY of keySet) - ". . .")) - ((AND (IGEQ n maxWord) - (CDR keyTail)) + (RPLACA keyTail (CONCAT (APPLY* GetHeaderFn wordNerd + (CAR keyTail) + headerIndex buffer))) (* ; - "remove the numbers after this one") - (* ; - "add overflow (LENGTH (CDR lemma))") - (SETQ overflow (LENGTH (CDR keyTail))) - (RPLACD keyTail NIL) - (RETURN] - (replace WNKEYDATA of keySet - with (SORT (fetch WNKEYDATA of keySet) - (FUNCTION UALPHORDER))) - [COND - (overflow (NCONC1 (fetch WNKEYDATA of keySet) - (CONCAT ". . .+" overflow " more."] - - (* ;; "finally, remove the WNKEYSETWEIGHT field") - - (RPLACD keySet (CDDR keySet] + "CONCAT will copy the string out of the buffer.") + (BLOCK))) + (COND + ((EQ n minWord) (* ; + "remove the numbers before this one") + (replace WNKEYDATA of keySet with keyTail) + (push (fetch WNKEY of keySet) + ". . .")) + ((AND (IGEQ n maxWord) + (CDR keyTail)) (* ; "remove the numbers after this one") + (* ; "add overflow (LENGTH (CDR lemma))") + (SETQ overflow (LENGTH (CDR keyTail))) + (RPLACD keyTail NIL) + (RETURN] + (replace WNKEYDATA of keySet with (SORT (fetch WNKEYDATA of keySet) + (FUNCTION UALPHORDER))) + [COND + (overflow (NCONC1 (fetch WNKEYDATA of keySet) + (CONCAT ". . .+" overflow " more."] + + (* ;; "finally, remove the WNKEYSETWEIGHT field") + + (RPLACD keySet (CDDR keySet] (* ;; "COND ((NEQ overflow 0) (* append the overflow information) (NCONC1 (CADAR (LAST venn)) (CONCAT '. . .+' overflow ' more.')))") @@ -464,7 +433,7 @@ The default implementations are given below.) (COND ((AND array (IGREATERP arrayMax (ARRAYSIZE array))) (* ; - "the data has grown since we last saw it.") + "the data has grown since we last saw it.") (SETQ array NIL))) [COND ((NULL array) @@ -481,36 +450,36 @@ The default implementations are given below.) [for word word# weight length freq factor inside weightedKeys do (SETQ wordList NIL) - (COND - ((LISTP word) - (SETQ word (CAR word)) - (SETQ factor (CADR word))) - (T (SETQ factor 1))) - (COND - ([SETQ word# (COND - ((OR (NULL GetKeyFn) - (NUMBERP word)) - word) - (T (APPLY* GetKeyFn wordNerd word keyIndex] - [SETQ freq (COND - ((LISTP word#) - (LENGTH word#)) - ((NULL GetFreqFn) - (SETQ word# (APPLY* GetEntryFn wordNerd word# indexFile)) - (LENGTH word#)) - (T (APPLY* GetFreqFn wordNerd word# indexFile] - (COND - ((NEQ freq 0) - (SETQ weight (COND - [useFreqWeights (ITIMES factor - (IMAX 1 (LRSH (IQUOTIENT entryCount - freq) - shiftFactor] - (T factor))) - (COND - ((IGEQ (ABS weight) - minimumWeight) - (push weights (LIST word# weight word wordList] + (COND + ((LISTP word) + (SETQ word (CAR word)) + (SETQ factor (CADR word))) + (T (SETQ factor 1))) + (COND + ([SETQ word# (COND + ((OR (NULL GetKeyFn) + (NUMBERP word)) + word) + (T (APPLY* GetKeyFn wordNerd word keyIndex] + [SETQ freq (COND + ((LISTP word#) + (LENGTH word#)) + ((NULL GetFreqFn) + (SETQ word# (APPLY* GetEntryFn wordNerd word# indexFile)) + (LENGTH word#)) + (T (APPLY* GetFreqFn wordNerd word# indexFile] + (COND + ((NEQ freq 0) + (SETQ weight (COND + [useFreqWeights (ITIMES factor (IMAX 1 (LRSH (IQUOTIENT + entryCount + freq) + shiftFactor] + (T factor))) + (COND + ((IGEQ (ABS weight) + minimumWeight) + (push weights (LIST word# weight word wordList] (* ;;; "sort weights from greatest to least. We may not have to process all of the keys, so do the most significant ones first.") @@ -520,101 +489,93 @@ The default implementations are given below.) [SETQ keysLeft (COND (useFreqWeights maxKeys) (T (LENGTH weightedKeys] - [for tail weightedKey priorTail word weight singleWeight ignoreSingletons - (%#entries _ 0) on weights + [for tail weightedKey priorTail word weight singleWeight ignoreSingletons (%#entries _ 0) + on weights do (BLOCK) - (SETQ weightedKey (CAR tail)) - (SETQ weight (CADR weightedKey)) - (SETQ word (CADDR weightedKey)) - [SETQ wordList (COND - ((LISTP (CAR weightedKey)) - (CAR weightedKey)) - (T (APPLY* GetEntryFn wordNerd (CAR weightedKey) - indexFile] - (RPLACA weightedKey word) - (RPLACD (CDR weightedKey) - NIL) - (COND - [(CDR wordList) (* ; - "ignore lists with less than 2 and more than 2000 entries.") - (add keysLeft -1) - (SETQ priorTail tail) - [COND - ((AND singleWeight (NOT ignoreSingletons)) - (SETQ ignoreSingletons - (IGEQ singleWeight - (for remaining in tail as I from 1 to keysLeft - sum (CADR remaining] - (add %#entries (AddWeightsToArray array wordList weight word - ignoreSingletons)) - [COND - ((AND maxWord (IGEQ %#entries maxWord)) - (* ; - "keep track of the maximum weight of any key that could satisfy the query all by itself.") - (COND - ((OR (NULL singleWeight) - (IGREATERP weight singleWeight)) - (SETQ singleWeight weight] - (COND - ((EQ keysLeft 0) - (RPLACD tail NIL) - (RETURN] - (priorTail (RPLACD priorTail (CDR tail))) - (T (SETQ weights (CDR tail] + (SETQ weightedKey (CAR tail)) + (SETQ weight (CADR weightedKey)) + (SETQ word (CADDR weightedKey)) + [SETQ wordList (COND + ((LISTP (CAR weightedKey)) + (CAR weightedKey)) + (T (APPLY* GetEntryFn wordNerd (CAR weightedKey) + indexFile] + (RPLACA weightedKey word) + (RPLACD (CDR weightedKey) + NIL) + (COND + [(CDR wordList) (* ; + "ignore lists with less than 2 and more than 2000 entries.") + (add keysLeft -1) + (SETQ priorTail tail) + [COND + ((AND singleWeight (NOT ignoreSingletons)) + (SETQ ignoreSingletons + (IGEQ singleWeight (for remaining in tail as I from 1 to keysLeft + sum (CADR remaining] + (add %#entries (AddWeightsToArray array wordList weight word ignoreSingletons)) + [COND + ((AND maxWord (IGEQ %#entries maxWord))(* ; + "keep track of the maximum weight of any key that could satisfy the query all by itself.") + (COND + ((OR (NULL singleWeight) + (IGREATERP weight singleWeight)) + (SETQ singleWeight weight] + (COND + ((EQ keysLeft 0) + (RPLACD tail NIL) + (RETURN] + (priorTail (RPLACD priorTail (CDR tail))) + (T (SETQ weights (CDR tail] (SETQ priorityList (CDR (FindTopElements array maxWord arrayMax))) (AND minWord (IGREATERP minWord 0) (SETQ priorityList (NTH priorityList minWord))) [SETQ priorityList (for lemma (buffer _ (AND GetBufferFn (APPLY* GetBufferFn wordNerd - headerIndex))) - in priorityList collect - (* ; - "CONCAT will copy the string out of the buffer.") - (CONS (CONCAT (APPLY* GetHeaderFn wordNerd - (CADR lemma) - headerIndex buffer)) - (LIST (CAR lemma) - (DREVERSE (CDDDR lemma] + headerIndex))) in + priorityList + collect (* ; + "CONCAT will copy the string out of the buffer.") + (CONS (CONCAT (APPLY* GetHeaderFn wordNerd (CADR lemma) + headerIndex buffer)) + (LIST (CAR lemma) + (DREVERSE (CDDDR lemma] (LIST weights priorityList]) (AddWeightsToArray - [LAMBDA (array wordList weight word ignoreSingletons) (* jtm%: "17-Nov-87 14:49") + [LAMBDA (array wordList weight word ignoreSingletons) (* jtm%: "17-Nov-87 14:49") (for header index val elt (%#newEntries _ 0) in wordList do (SETQ index (LRSH header 8)) - (SETQ elt (ELT array index)) - (COND - ((AND [NULL (SETQ val (for I in elt thereis (EQP header (CAR I] - (NOT ignoreSingletons)) - (SETQ val (LIST header 0)) - (COND - (elt (ATTACH val elt)) - (T (push (ELT array index) - val))) - (add %#newEntries 1))) - (COND - (val (push (CDDR val) - word) - (add (CADR val) - weight))) finally (RETURN %#newEntries]) + (SETQ elt (ELT array index)) + (COND + ((AND [NULL (SETQ val (for I in elt thereis (EQP header (CAR I] + (NOT ignoreSingletons)) + (SETQ val (LIST header 0)) + (COND + (elt (ATTACH val elt)) + (T (push (ELT array index) + val))) + (add %#newEntries 1))) + (COND + (val (push (CDDR val) + word) + (add (CADR val) + weight))) finally (RETURN %#newEntries]) (FindTopElements - [LAMBDA (array maxWord arrayMax) (* jtm%: " 2-Aug-88 10:37") + [LAMBDA (array maxWord arrayMax) (* jtm%: " 2-Aug-88 10:37") (LET (priorityList) (for I from 0 to arrayMax do (for arrayVal in (ELT array I) - do - (* RPLACA (CDR arrayVal) - (ITIMES (CADR arrayVal) - (IMIN 5 (LENGTH (CDDR arrayVal))))) - (SETQ priorityList ( - AddToPriorityList - priorityList - arrayVal - (CADR arrayVal) - maxWord))) - (SETA array I NIL)) + do (* RPLACA (CDR arrayVal) + (ITIMES (CADR arrayVal) + (IMIN 5 (LENGTH (CDDR arrayVal))))) + (SETQ priorityList (AddToPriorityList priorityList + arrayVal (CADR arrayVal) + maxWord))) + (SETA array I NIL)) priorityList]) (AddToPriorityList - [LAMBDA (priorityList I VAL MAX) (* jtm%: " 6-Nov-87 15:12") + [LAMBDA (priorityList I VAL MAX) (* jtm%: " 6-Nov-87 15:12") (LET (inserted) [COND [(NULL priorityList) (* include a count at the beginning.) @@ -625,38 +586,37 @@ The default implementations are given below.) NIL) (T (for tail nextToLast last on priorityList as N from 0 do (COND - ((OR (NULL (CDR tail)) - (IGREATERP VAL (CAADR tail))) - (COND - ((EQ N MAX) - NIL) - ((AND [SETQ nextToLast (AND MAX (NTH tail (IDIFFERENCE MAX N] - (SETQ last (CDR nextToLast))) + ((OR (NULL (CDR tail)) + (IGREATERP VAL (CAADR tail))) + (COND + ((EQ N MAX) + NIL) + ((AND [SETQ nextToLast (AND MAX (NTH tail (IDIFFERENCE MAX N] + (SETQ last (CDR nextToLast))) (* re-use the nextToLast cell.) - (RPLACA (CAR priorityList) - (CAAR nextToLast)) - (RPLACD nextToLast NIL) (* remove last from the list.) - (RPLNODE (CAR last) - VAL I) (* update its values.) - (RPLACD last (CDR tail)) (* splice it into the list.) - (RPLACD tail last)) - (T (* (AND MAX (RPLACD - (NTH tail (IDIFFERENCE - (ADD1 MAX) N)) NIL))) - (RPLACD tail (CONS (CONS VAL I) - (CDR tail))) - (add (CDAR priorityList) - 1))) - (RETURN] + (RPLACA (CAR priorityList) + (CAAR nextToLast)) + (RPLACD nextToLast NIL) (* remove last from the list.) + (RPLNODE (CAR last) + VAL I) (* update its values.) + (RPLACD last (CDR tail)) (* splice it into the list.) + (RPLACD tail last)) + (T (* (AND MAX (RPLACD (NTH tail + (IDIFFERENCE (ADD1 MAX) N)) NIL))) + (RPLACD tail (CONS (CONS VAL I) + (CDR tail))) + (add (CDAR priorityList) + 1))) + (RETURN] priorityList]) ) (DEFINEQ (WordNerd.DefaultRelevanceSearch - [LAMBDA (wordNerd posWords negKeys minWord maxWord) (* jtm%: " 2-Aug-88 10:46") + [LAMBDA (wordNerd posWords negKeys minWord maxWord) (* jtm%: " 2-Aug-88 10:46") (* * extract keywords from the sample words given - (posWords) and do a weighted search.) + (posWords) and do a weighted search.) (LET (posKeys dictionary analyzer GetEntryTokensFn) [COND @@ -672,45 +632,45 @@ The default implementations are given below.) (SETQ dictionary (InvertedDict.Prop wordNerd 'DICTIONARY)) (SETQ GetEntryTokensFn (InvertedDict.Prop wordNerd 'GETENTRYTOKENSFN)) - (* * GetEntryTokensFn is in the wordNerd rather than its dictionary because - there may be more than one wordNerd for a particular dictionary - (as in the WordNerd and EtymologyNerd.)) + (* * GetEntryTokensFn is in the wordNerd rather than its dictionary because there + may be more than one wordNerd for a particular dictionary + (as in the WordNerd and EtymologyNerd.)) (SETQ posKeys (MergeKeywords (for word in posWords - collect (APPLY* GetEntryTokensFn wordNerd word - dictionary analyzer)) + collect (APPLY* GetEntryTokensFn wordNerd word dictionary + analyzer)) negKeys)) (WordNerd.WeightedSearch wordNerd posKeys minWord maxWord T]) (MergeKeywords - [LAMBDA (posWordLists negKeywords minimumMatches negWordLists) + [LAMBDA (posWordLists negKeywords minimumMatches negWordLists) (* jtm%: " 1-Aug-88 15:11") (LET (intersection minimum n m order list) (OR minimumMatches (SETQ minimumMatches 2)) [while posWordLists do (SETQ n 0) - (SETQ minimum NIL) - [for tail on posWordLists when (CAR tail) - do (COND - ((OR (NULL minimum) - (ALPHORDER (CAAR tail) - minimum)) - (SETQ minimum (CAAR tail] - (OR minimum (RETURN)) - [for tail on posWordLists when (CAR tail) - do (while (EQUAL minimum (CAAR tail)) - do (add n 1) - (pop (CAR tail] - (COND - ([AND (NOT (MEMBER minimum negKeywords)) - (OR (IGEQ n minimumMatches) - (NULL (CDR posWordLists] - (push intersection (LIST minimum n] + (SETQ minimum NIL) + [for tail on posWordLists when (CAR tail) + do (COND + ((OR (NULL minimum) + (ALPHORDER (CAAR tail) + minimum)) + (SETQ minimum (CAAR tail] + (OR minimum (RETURN)) + [for tail on posWordLists when (CAR tail) + do (while (EQUAL minimum (CAAR tail)) + do (add n 1) + (pop (CAR tail] + (COND + ([AND (NOT (MEMBER minimum negKeywords)) + (OR (IGEQ n minimumMatches) + (NULL (CDR posWordLists] + (push intersection (LIST minimum n] intersection]) ) (DEFINEQ (WORDNERD.PARSEINPUT - [LAMBDA (INVERTEDDICT STRING IGNOREPARENS) (* jtm%: "12-Aug-88 16:45") + [LAMBDA (INVERTEDDICT STRING IGNOREPARENS) (* jtm%: "12-Aug-88 16:45") (LET (ANALYZER KEYS SUBKEYS ENDPOS SUBSTRING (STARTPOS 1) (NCHARS (NCHARS STRING))) (SETQ ANALYZER (InvertedDict.Prop INVERTEDDICT 'ANALYZER)) @@ -720,28 +680,26 @@ The default implementations are given below.) (InvertedDict.Prop INVERTEDDICT 'ANALYZER ANALYZER))) [while STARTPOS do (OR IGNOREPARENS (SETQ ENDPOS (STRPOS "(" STRING STARTPOS))) - [SETQ SUBSTRING (SUBSTRING STRING STARTPOS (SUB1 (OR ENDPOS (ADD1 NCHARS] - [AND SUBSTRING (Analyzer.Analyze ANALYZER SUBSTRING NIL NIL - (FUNCTION (LAMBDA (ANALYZER STREAM START LENGTH ENTRY) - (push KEYS - (OR ENTRY (STREAM.FETCHSTRING STREAM START - LENGTH NIL T))) + [SETQ SUBSTRING (SUBSTRING STRING STARTPOS (SUB1 (OR ENDPOS (ADD1 NCHARS] + [AND SUBSTRING (Analyzer.Analyze ANALYZER SUBSTRING NIL NIL + (FUNCTION (LAMBDA (ANALYZER STREAM START LENGTH ENTRY) + (push KEYS (OR ENTRY (STREAM.FETCHSTRING STREAM + START LENGTH NIL T))) + NIL] + (COND + [ENDPOS (SETQ STARTPOS (ADD1 ENDPOS)) + (SETQ ENDPOS (STRPOS ")" STRING STARTPOS)) + (SETQ SUBKEYS NIL) + [Analyzer.Analyze ANALYZER [SUBSTRING STRING STARTPOS + (SUB1 (OR ENDPOS (ADD1 NCHARS] + NIL NIL (FUNCTION (LAMBDA (ANALYZER STREAM START LENGTH ENTRY) + (push SUBKEYS + (OR ENTRY (STREAM.FETCHSTRING STREAM START + LENGTH NIL T))) NIL] - (COND - [ENDPOS (SETQ STARTPOS (ADD1 ENDPOS)) - (SETQ ENDPOS (STRPOS ")" STRING STARTPOS)) - (SETQ SUBKEYS NIL) - [Analyzer.Analyze ANALYZER [SUBSTRING STRING STARTPOS - (SUB1 (OR ENDPOS (ADD1 NCHARS] - NIL NIL (FUNCTION (LAMBDA (ANALYZER STREAM START LENGTH ENTRY) - (push SUBKEYS - (OR ENTRY - (STREAM.FETCHSTRING STREAM START - LENGTH NIL T))) - NIL] - (push KEYS (DREVERSE SUBKEYS)) - (SETQ STARTPOS (ADD1 (OR ENDPOS NCHARS] - (T (SETQ STARTPOS NIL] + (push KEYS (DREVERSE SUBKEYS)) + (SETQ STARTPOS (ADD1 (OR ENDPOS NCHARS] + (T (SETQ STARTPOS NIL] (SETQ KEYS (DREVERSE KEYS]) ) (DECLARE%: EVAL@COMPILE @@ -753,7 +711,7 @@ The default implementations are given below.) (DEFINEQ (SimpleNerd.Create - [LAMBDA (NAME DICTIONARY ANALYZER) (* ; "Edited 25-Oct-88 12:01 by jtm:") + [LAMBDA (NAME DICTIONARY ANALYZER) (* ; "Edited 25-Oct-88 12:01 by jtm:") (LET (SIMPLENERD) (SETQ SIMPLENERD (create INVERTEDDICT INVERTEDDICTNAME _ NAME)) @@ -772,7 +730,7 @@ The default implementations are given below.) SIMPLENERD]) (SimpleNerd.AddAssociation - [LAMBDA (WORDNERD HEADER KEY) (* ; "Edited 21-Sep-88 14:37 by jtm:") + [LAMBDA (WORDNERD HEADER KEY) (* ; "Edited 21-Sep-88 14:37 by jtm:") (* * adds KEY to WORDNERD under HEADER.) @@ -786,22 +744,20 @@ The default implementations are given below.) (replace (INVERTEDDICT HEADERINDEX) of WORDNERD with HEADERINDEX))) (COND ((NULL (SETQ INDEXFILE (fetch (INVERTEDDICT INDEXFILE) of WORDNERD))) - (SETQ INDEXFILE (SimpleDict.New (fetch (INVERTEDDICT INVERTEDDICTNAME) of - WORDNERD - ))) + (SETQ INDEXFILE (SimpleDict.New (fetch (INVERTEDDICT INVERTEDDICTNAME) of WORDNERD))) (replace (INVERTEDDICT INDEXFILE) of WORDNERD with INDEXFILE))) [COND ([NULL (SETQ LASTENTRY (InvertedDict.Prop WORDNERD 'LASTENTRY] (SETQ LASTENTRY (CONS NIL 0] (* * map HEADER to a unique ID using EQUAL. - We want ID numbers to make it easier to convert to external indices.) + We want ID numbers to make it easier to convert to external indices.) (COND ((EQ HEADER :STOPWORD) (* do nothing) NIL) ((EQUAL HEADER (CAR LASTENTRY)) (* this is optimized for multiple - additions to the same entry.) + additions to the same entry.) (SETQ ENTRYID (CDR LASTENTRY))) ([SETQ ENTRYID (for I from 1 to (SETQ HEADERSIZE (ARRAYSIZE HEADERINDEX)) thereis (EQUAL HEADER (ELT HEADERINDEX I] @@ -814,19 +770,17 @@ The default implementations are given below.) ((IGREATERP ENTRYID HEADERSIZE) (LET (NEWHEADERINDEX) (* get a bigger array.) (SETQ NEWHEADERINDEX (ARRAY (ITIMES HEADERSIZE 2))) - (for I from 1 to HEADERSIZE do (SETA NEWHEADERINDEX I - (ELT HEADERINDEX I))) - (replace (INVERTEDDICT HEADERINDEX) of WORDNERD with - NEWHEADERINDEX) + (for I from 1 to HEADERSIZE do (SETA NEWHEADERINDEX I (ELT HEADERINDEX I))) + (replace (INVERTEDDICT HEADERINDEX) of WORDNERD with NEWHEADERINDEX) (SETQ HEADERINDEX NEWHEADERINDEX] (SETA HEADERINDEX ENTRYID HEADER) (InvertedDict.Prop WORDNERD 'LASTINDEX ENTRYID))) (* * push the HEADER onto INDEXFILE) (* used to - #.(SEDIT::MAKE-BROKEN-ATOM "be:") - (SimpleDict.PushEntry INDEXFILE KEY - ENTRYID (QUOTE NEWTOP))) + #.(SEDIT::MAKE-BROKEN-ATOM "be:") + (SimpleDict.PushEntry INDEXFILE KEY + ENTRYID (QUOTE NEWTOP))) (COND ((EQ HEADER :STOPWORD) (* mark as stop word) (SimpleDict.PutEntry INDEXFILE KEY :STOPWORD)) @@ -839,7 +793,7 @@ The default implementations are given below.) (T (SimpleDict.PutEntry INDEXFILE KEY (LIST ENTRYID]) (SimpleNerd.MapKeys - [LAMBDA (NERD MAPFN) (* ; "Edited 25-Oct-88 11:57 by jtm:") + [LAMBDA (NERD MAPFN) (* ; "Edited 25-Oct-88 11:57 by jtm:") (* ;; "Map through all of the keys in the NERD") @@ -850,25 +804,25 @@ The default implementations are given below.) (SETQ HEADER (CONCATLIST PATH)) (* ; "PATH is a list of characters") (APPLY* MAPFN NERD HEADER HEADER ENTRY)) (* ; - "KEY and KEYID are the same. ENTRY may be :STOPWORD") + "KEY and KEYID are the same. ENTRY may be :STOPWORD") ]) (SimpleNerd.GetEntry - [LAMBDA (WORDNERD KEYID INDEXFILE) (* jtm%: " 2-Aug-88 10:13") + [LAMBDA (WORDNERD KEYID INDEXFILE) (* jtm%: " 2-Aug-88 10:13") (SimpleDict.Lookup INDEXFILE KEYID]) (SimpleNerd.MaxEntry - [LAMBDA (WORDNERD HEADERINDEX) (* jtm%: " 1-Aug-88 16:44") + [LAMBDA (WORDNERD HEADERINDEX) (* jtm%: " 1-Aug-88 16:44") (InvertedDict.Prop WORDNERD 'LASTINDEX]) (SimpleNerd.GetHeader - [LAMBDA (WORDNERD HEADERID HEADERINDEX BUFFER) (* ; "Edited 11-Nov-88 14:30 by jtm:") + [LAMBDA (WORDNERD HEADERID HEADERINDEX BUFFER) (* ; "Edited 11-Nov-88 14:30 by jtm:") (COND (HEADERINDEX (ELT HEADERINDEX HEADERID)) (T HEADERID]) (SimpleNerd.ParseDictEntry - [LAMBDA (WORDNERD WORD DICTIONARY ANALYZER) (* ; "Edited 24-Oct-88 14:19 by jtm:") + [LAMBDA (WORDNERD WORD DICTIONARY ANALYZER) (* ; "Edited 24-Oct-88 14:19 by jtm:") (* * return the list of tokens in the definition of WORD.) @@ -885,7 +839,7 @@ The default implementations are given below.) LENGTH NIL T))) (PUTHASH TOKEN T HARRAY) (* ; - "return NIL to keep iteration going") + "return NIL to keep iteration going") NIL] (COND ((STREAMP DICTENTRY) @@ -895,7 +849,7 @@ The default implementations are given below.) TOKENS]) (SimpleNerd.Test - [LAMBDA NIL (* jtm%: " 2-Aug-88 14:54") + [LAMBDA NIL (* jtm%: " 2-Aug-88 14:54") (LET (simpleNerd simpleDict analyzer GetEntryTokensFn) (SETQ simpleDict (SimpleDict.New 'TEST)) (Dict.PutEntry simpleDict "Paine" @@ -903,8 +857,7 @@ The default implementations are given below.) (Dict.PutEntry simpleDict "Jefferson" "Now is the time for good men to help out.") (Dict.PutEntry simpleDict "King George" "Now wait a minute!") (Dict.PutEntry simpleDict "Kennedy" "Ask not what your country can do for you.") - (replace (Dict printEntryFn) of simpleDict with (FUNCTION - DictTool.PrintDefinition)) + (replace (Dict printEntryFn) of simpleDict with (FUNCTION DictTool.PrintDefinition)) (Dict.Establish simpleDict) (SETQ simpleNerd (SimpleNerd.Create 'TEST)) (InvertedDict.Prop simpleNerd 'DICTIONARY simpleDict) @@ -918,8 +871,8 @@ The default implementations are given below.) simpleNerd string simpleDict analyzer)) (for token in tokens - do (SimpleNerd.AddEntry simpleNerd - string token] + do (SimpleNerd.AddEntry simpleNerd string + token] (SETQ TESTNERD simpleNerd]) ) (* * HashfileNerd stores its data structures in an InterLisp hashfile.) @@ -927,7 +880,7 @@ The default implementations are given below.) (DEFINEQ (HashfileNerd.Create - [LAMBDA (NAME FILENAME DICTIONARY ANALYZER) (* ; "Edited 17-Nov-88 17:03 by jtm:") + [LAMBDA (NAME FILENAME DICTIONARY ANALYZER) (* ; "Edited 17-Nov-88 17:03 by jtm:") (LET (NERD) (SETQ NERD (create INVERTEDDICT INVERTEDDICTNAME _ NAME @@ -955,7 +908,7 @@ The default implementations are given below.) NERD]) (HashfileNerd.Test - [LAMBDA (FILEPATTERN FILENAME) (* ; "Edited 26-Sep-88 13:30 by jtm:") + [LAMBDA (FILEPATTERN FILENAME) (* ; "Edited 26-Sep-88 13:30 by jtm:") (LET (NERD DICT) (SETQ DICT (FileDict.Create 'TEST)) (FileDict.AddFiles DICT FILEPATTERN) @@ -968,7 +921,7 @@ The default implementations are given below.) NERD]) (HashfileNerd.Open - [LAMBDA (WORDNERD FILENAME) (* ; "Edited 11-Nov-88 11:34 by jtm:") + [LAMBDA (WORDNERD FILENAME) (* ; "Edited 11-Nov-88 11:34 by jtm:") (* ;;; "Reads a hashfilenerd out of the hashfile stored in FILENAME") @@ -980,9 +933,11 @@ The default implementations are given below.) (* ;; "read out the name") - (replace (INVERTEDDICT INVERTEDDICTNAME) of WORDNERD - with (OR (GETHASHFILE '*NAME* HASHFILE) - (fetch (INVERTEDDICT INVERTEDDICTNAME) of WORDNERD))) + (replace (INVERTEDDICT INVERTEDDICTNAME) of WORDNERD with (OR (GETHASHFILE '*NAME* + HASHFILE) + (fetch (INVERTEDDICT + INVERTEDDICTNAME) + of WORDNERD))) (* ;; "read out the HEADERINDEX") @@ -990,14 +945,12 @@ The default implementations are given below.) ((SETQ HEADERLIST (GETHASHFILE '*HEADERINDEX* HASHFILE)) [SETQ HEADERINDEX (ARRAY (IPLUS 10 (LENGTH HEADERLIST] (for I in HEADERLIST do (SETA HEADERINDEX (CAR I) - (CADR I] + (CADR I] (* ;; "read out simple properties") - (for PROP in (GETHASHFILE '*PROPS* HASHFILE) do (InvertedDict.Prop - WORDNERD - (CAR PROP) - (CDR PROP))) + (for PROP in (GETHASHFILE '*PROPS* HASHFILE) do (InvertedDict.Prop WORDNERD (CAR PROP) + (CDR PROP))) (replace (INVERTEDDICT HEADERINDEX) of WORDNERD with HEADERINDEX) (* ;; "check the dictionary name") @@ -1019,7 +972,7 @@ The default implementations are given below.) (replace (INVERTEDDICT INDEXFILE) of WORDNERD with HASHFILE]) (HashfileNerd.Close - [LAMBDA (WORDNERD) (* ; "Edited 15-Sep-88 10:04 by jtm:") + [LAMBDA (WORDNERD) (* ; "Edited 15-Sep-88 10:04 by jtm:") (LET (INDEXFILE) (SETQ INDEXFILE (fetch (INVERTEDDICT INDEXFILE) of WORDNERD)) [COND @@ -1036,7 +989,7 @@ The default implementations are given below.) NIL]) (HashfileNerd.Write - [LAMBDA (WORDNERD FILENAME) (* ; "Edited 11-Nov-88 11:32 by jtm:") + [LAMBDA (WORDNERD FILENAME) (* ; "Edited 11-Nov-88 11:32 by jtm:") (* ;;; "Write out WORDNERD onto a hashfile so that it can be read back in later.") @@ -1055,7 +1008,7 @@ The default implementations are given below.) (SETQ INDEXFILE (fetch (INVERTEDDICT INDEXFILE) of WORDNERD)) (COND ((LISTP INDEXFILE) (* ; - "information was added to an existing hashfile") + "information was added to an existing hashfile") (SETQ HASHARRAY (CAR INDEXFILE)) (SETQ HASHFILE (CDR INDEXFILE))) ((HASHFILEP INDEXFILE) @@ -1070,7 +1023,7 @@ The default implementations are given below.) [COND (HASHARRAY (* ; "write new entries out") (BIGMAPHASH HASHARRAY (FUNCTION (LAMBDA (VAL KEY) - (PUTHASHFILE KEY VAL HASHFILE] + (PUTHASHFILE KEY VAL HASHFILE] (* ;; "store the name on the hashfile if it has changed.") @@ -1082,8 +1035,7 @@ The default implementations are given below.) (* ;; " store HEADERINDEX on the hashfile if it has changed.") (SETQ HEADERINDEX (fetch (INVERTEDDICT HEADERINDEX) of WORDNERD)) - [SETQ HEADERLIST (AND HEADERINDEX (for I ENTRY from 1 - while (SETQ ENTRY (ELT HEADERINDEX I)) + [SETQ HEADERLIST (AND HEADERINDEX (for I ENTRY from 1 while (SETQ ENTRY (ELT HEADERINDEX I)) collect (LIST I ENTRY] (COND ((NOT (EQUAL HEADERLIST (GETHASHFILE '*HEADERINDEX* HASHFILE))) @@ -1091,9 +1043,8 @@ The default implementations are given below.) (* ;; " store simple properties on the hashfile if they have changed.") - (SETQ PROPS (for PROP in (fetch (INVERTEDDICT INVERTEDDICTPROPS) of WORDNERD - ) when (SIMPLETYPE (CDR PROP)) collect - PROP)) + (SETQ PROPS (for PROP in (fetch (INVERTEDDICT INVERTEDDICTPROPS) of WORDNERD) + when (SIMPLETYPE (CDR PROP)) collect PROP)) (COND ((NOT (EQUAL PROPS (GETHASHFILE '*PROPS* HASHFILE))) (PUTHASHFILE '*PROPS* PROPS HASHFILE))) @@ -1108,9 +1059,8 @@ The default implementations are given below.) (* ;; "store the name of the analyzer if it has changed.") - (SETQ ANALYZERNAME (AND [type? Morphalyzer (SETQ ANALYZER (InvertedDict.Prop - WORDNERD - 'DICTIONARY] + (SETQ ANALYZERNAME (AND [type? Morphalyzer (SETQ ANALYZER (InvertedDict.Prop WORDNERD + 'DICTIONARY] (Analyzer.Name ANALYZER))) (COND ((NEQ ANALYZERNAME (GETHASHFILE '*ANALYZER* HASHFILE)) @@ -1125,7 +1075,7 @@ The default implementations are given below.) HASHFILE]) (SIMPLETYPE - [LAMBDA (DATUM) (* ; "Edited 15-Sep-88 14:33 by jtm:") + [LAMBDA (DATUM) (* ; "Edited 15-Sep-88 14:33 by jtm:") (COND ((NUMBERP DATUM) T) @@ -1137,7 +1087,7 @@ The default implementations are given below.) (for I inside DATUM always (SIMPLETYPE I]) (HashfileNerd.AddAssociation - [LAMBDA (WORDNERD HEADER KEY) (* ; "Edited 11-Nov-88 11:30 by jtm:") + [LAMBDA (WORDNERD HEADER KEY) (* ; "Edited 11-Nov-88 11:30 by jtm:") (* * adds KEY to WORDNERD under HEADER.) @@ -1177,7 +1127,7 @@ The default implementations are given below.) (SETQ LASTENTRY (CONS NIL 0] (* * map HEADER to a unique ID using EQUAL. - We want ID numbers to make it easier to convert to external indices.) + We want ID numbers to make it easier to convert to external indices.) (COND ((EQ HEADER :STOPWORD) (* don't add header to header index.) @@ -1185,7 +1135,7 @@ The default implementations are given below.) ((NULL HEADERINDEX) (* Identity mapping) (SETQ ENTRYID HEADER)) ((EQUAL HEADER (CAR LASTENTRY)) (* this is optimized for multiple - additions to the same entry.) + additions to the same entry.) (SETQ ENTRYID (CDR LASTENTRY))) ([SETQ ENTRYID (for I from 1 to (SETQ HEADERSIZE (ARRAYSIZE HEADERINDEX)) thereis (EQUAL HEADER (ELT HEADERINDEX I] @@ -1198,10 +1148,8 @@ The default implementations are given below.) ((IGREATERP ENTRYID HEADERSIZE) (LET (NEWHEADERINDEX) (* get a bigger array.) (SETQ NEWHEADERINDEX (ARRAY (ITIMES HEADERSIZE 2))) - (for I from 1 to HEADERSIZE do (SETA NEWHEADERINDEX I - (ELT HEADERINDEX I))) - (replace (INVERTEDDICT HEADERINDEX) of WORDNERD with - NEWHEADERINDEX) + (for I from 1 to HEADERSIZE do (SETA NEWHEADERINDEX I (ELT HEADERINDEX I))) + (replace (INVERTEDDICT HEADERINDEX) of WORDNERD with NEWHEADERINDEX) (SETQ HEADERINDEX NEWHEADERINDEX] (SETA HEADERINDEX ENTRYID HEADER) (InvertedDict.Prop WORDNERD 'LASTINDEX ENTRYID))) @@ -1226,7 +1174,7 @@ The default implementations are given below.) HASHARRAY]) (HashfileNerd.GetEntry - [LAMBDA (WORDNERD KEYID INDEXFILE) (* ; "Edited 11-Nov-88 14:28 by jtm:") + [LAMBDA (WORDNERD KEYID INDEXFILE) (* ; "Edited 11-Nov-88 14:28 by jtm:") [COND ((NULL INDEXFILE) (SETQ INDEXFILE (fetch (INVERTEDDICT INDEXFILE) of WORDNERD] @@ -1243,7 +1191,7 @@ The default implementations are given below.) (GETHASH KEYID INDEXFILE]) (HashfileNerd.ExpandKeyPattern - [LAMBDA (NERD KEYPATTERN) (* ; "Edited 17-Nov-88 16:58 by jtm:") + [LAMBDA (NERD KEYPATTERN) (* ; "Edited 17-Nov-88 16:58 by jtm:") (LET (PAT INDEXFILE KEYS HASHARRAY HASHFILE) (SETQ PAT (DIRECTORY.MATCH.SETUP KEYPATTERN)) (SETQ INDEXFILE (fetch (INVERTEDDICT INDEXFILE) of NERD)) @@ -1258,18 +1206,18 @@ The default implementations are given below.) (SETQ HASHFILE (CDR INDEXFILE] [if HASHARRAY then (BIGMAPHASH HASHARRAY (FUNCTION (LAMBDA (DATA KEY) - (COND - ((DIRECTORY.MATCH PAT KEY) - (push KEYS KEY] + (COND + ((DIRECTORY.MATCH PAT KEY) + (push KEYS KEY] [if HASHFILE then (MAPHASHFILE HASHFILE (FUNCTION (LAMBDA (DATA KEY) - (COND - ((DIRECTORY.MATCH PAT KEY) - (push KEYS KEY] + (COND + ((DIRECTORY.MATCH PAT KEY) + (push KEYS KEY] KEYS]) (HashfileNerd.MapKeys - [LAMBDA (NERD KEYFN) (* ; "Edited 17-Nov-88 16:29 by jtm:") + [LAMBDA (NERD KEYFN) (* ; "Edited 17-Nov-88 16:29 by jtm:") (* ;;; "maps through all of the keys in the hash array/ file") @@ -1286,16 +1234,15 @@ The default implementations are given below.) (SETQ HASHFILE (CDR INDEXFILE] [if HASHARRAY then (BIGMAPHASH HASHARRAY (FUNCTION (LAMBDA (DATA KEY) - (APPLY* KEYFN NERD KEY DATA] + (APPLY* KEYFN NERD KEY DATA] (if HASHFILE then (MAPHASHFILE HASHFILE (FUNCTION (LAMBDA (DATA KEY) - (APPLY* KEYFN NERD KEY DATA]) + (APPLY* KEYFN NERD KEY DATA]) ) (DEFINEQ (BIGHASH - [LAMBDA (MAXKEYLENGTH MINKEYS OVERFLOW HASHBITSFN EQUIVFN) - (* ; "Edited 11-Nov-88 11:19 by jtm:") + [LAMBDA (MAXKEYLENGTH MINKEYS OVERFLOW HASHBITSFN EQUIVFN) (* ; "Edited 11-Nov-88 11:19 by jtm:") (* ;; "A BIGHASH first hashes keys into an array by key length to get a hash array and then hashes the key in that hash array.") @@ -1308,7 +1255,7 @@ The default implementations are given below.) BIGHASHEQUIVFN _ EQUIVFN]) (BIGGETHASH - [LAMBDA (KEY BIGHASH) (* ; "Edited 11-Nov-88 11:04 by jtm:") + [LAMBDA (KEY BIGHASH) (* ; "Edited 11-Nov-88 11:04 by jtm:") (* ;; "get the value from the hash array that has keys of KEY's length") @@ -1322,20 +1269,19 @@ The default implementations are given below.) (T (GETHASH KEY BIGHASH]) (BIGHASHSIZE - [LAMBDA (BIGHASH) (* ; "Edited 11-Nov-88 11:28 by jtm:") + [LAMBDA (BIGHASH) (* ; "Edited 11-Nov-88 11:28 by jtm:") (LET (ARRAY) (COND [(type? BIGHASH BIGHASH) (SETQ ARRAY (fetch BIGHASHARRAY of BIGHASH)) - (for I HARRAY from 0 to (SUB1 (ARRAYSIZE ARRAY)) - sum (COND - ((SETQ HARRAY (ELT ARRAY I)) - (HARRAYSIZE HARRAY)) - (T 0] + (for I HARRAY from 0 to (SUB1 (ARRAYSIZE ARRAY)) sum (COND + ((SETQ HARRAY (ELT ARRAY I)) + (HARRAYSIZE HARRAY)) + (T 0] (T (HARRAYSIZE BIGHASH]) (BIGMAPHASH - [LAMBDA (BIGHASH MAPBHFN) (* ; "Edited 11-Nov-88 11:10 by jtm:") + [LAMBDA (BIGHASH MAPBHFN) (* ; "Edited 11-Nov-88 11:10 by jtm:") (* ;; "map through all of the keys in the sub-hashes.") @@ -1343,14 +1289,13 @@ The default implementations are given below.) (COND [(type? BIGHASH BIGHASH) (SETQ ARRAY (fetch BIGHASHARRAY of BIGHASH)) - (for I HARRAY from 0 to (SUB1 (ARRAYSIZE ARRAY)) - do (COND - ((SETQ HARRAY (ELT ARRAY I)) - (MAPHASH HARRAY MAPBHFN] + (for I HARRAY from 0 to (SUB1 (ARRAYSIZE ARRAY)) do (COND + ((SETQ HARRAY (ELT ARRAY I)) + (MAPHASH HARRAY MAPBHFN] (T (MAPHASH BIGHASH MAPBHFN]) (BIGPUTHASH - [LAMBDA (KEY VAL BIGHASH) (* ; "Edited 11-Nov-88 11:02 by jtm:") + [LAMBDA (KEY VAL BIGHASH) (* ; "Edited 11-Nov-88 11:02 by jtm:") (* ;; "put all of the keys with the same lengths together.") @@ -1373,7 +1318,7 @@ The default implementations are given below.) (DECLARE%: EVAL@COMPILE (PUTPROPS BIGHASHP MACRO ((ARRAY) - (type? BIGHASH ARRAY))) + (type? BIGHASH ARRAY))) ) (DECLARE%: EVAL@COMPILE @@ -1384,7 +1329,7 @@ The default implementations are given below.) (DEFINEQ (FileDict.Create - [LAMBDA (NAME FILENAME) (* ; "Edited 15-Sep-88 14:02 by jtm:") + [LAMBDA (NAME FILENAME) (* ; "Edited 15-Sep-88 14:02 by jtm:") (LET (DICT) (SETQ DICT (SimpleDict.Create NAME FILENAME)) (replace (Dict getEntryFn) of DICT with (FUNCTION FileDict.Lookup)) @@ -1394,14 +1339,14 @@ The default implementations are given below.) DICT]) (FileDict.AddFiles - [LAMBDA (DICT FILEPATTERN) (* ; "Edited 14-Sep-88 16:30 by jtm:") - (for FULLNAME in (SORT (DIRECTORY FILEPATTERN)) do (Dict.PutEntry DICT - (FILENAMEFIELD FULLNAME - 'NAME) - FULLNAME]) + [LAMBDA (DICT FILEPATTERN) (* ; "Edited 14-Sep-88 16:30 by jtm:") + (for FULLNAME in (SORT (DIRECTORY FILEPATTERN)) do (Dict.PutEntry DICT (FILENAMEFIELD + FULLNAME + 'NAME) + FULLNAME]) (FileDict.PrintEntry - [LAMBDA (DICT KEY STREAM) (* ; "Edited 14-Sep-88 16:38 by jtm:") + [LAMBDA (DICT KEY STREAM) (* ; "Edited 14-Sep-88 16:38 by jtm:") (LET (FILE) (COND ((SETQ FILE (SimpleDict.Lookup DICT KEY)) @@ -1409,19 +1354,19 @@ The default implementations are given below.) ""]) (FileDict.Write - [LAMBDA (DICT FILENAME) (* ; "Edited 15-Sep-88 11:13 by jtm:") + [LAMBDA (DICT FILENAME) (* ; "Edited 15-Sep-88 11:13 by jtm:") (LET (STREAM) (SETQ STREAM (OPENSTREAM FILENAME 'OUTPUT]) (FileDict.Lookup - [LAMBDA (DICT KEY) (* ; "Edited 14-Sep-88 15:08 by jtm:") + [LAMBDA (DICT KEY) (* ; "Edited 14-Sep-88 15:08 by jtm:") (LET (FILE) (COND ((SETQ FILE (SimpleDict.Lookup DICT KEY)) (FETCHSTRINGFROMFILE FILE]) (FileDict.MapEntries - [LAMBDA (DICT FDMAPFN PROP) (* ; "Edited 14-Sep-88 15:26 by jtm:") + [LAMBDA (DICT FDMAPFN PROP) (* ; "Edited 14-Sep-88 15:26 by jtm:") (SimpleDict.MapEntries DICT (FUNCTION (LAMBDA (DICT KEY FILENAME) (LET (STREAM) (SETQ STREAM (OPENTEXTSTREAM FILENAME)) @@ -1430,13 +1375,13 @@ The default implementations are given below.) (CLOSEF STREAM]) (FETCHSTRINGFROMFILE - [LAMBDA (FILENAME) (* ; "Edited 15-Sep-88 11:01 by jtm:") + [LAMBDA (FILENAME) (* ; "Edited 15-Sep-88 11:01 by jtm:") (* LET (STREAM STRING) - (SETQ STREAM (OPENTEXTSTREAM - FILENAME)) (TEDIT.SETSEL STREAM 1 - 10000 (QUOTE LEFT)) - (SETQ STRING (TEDIT.SEL.AS.STRING - STREAM)) (CLOSEF STREAM)) + (SETQ STREAM (OPENTEXTSTREAM FILENAME)) + (TEDIT.SETSEL STREAM 1 10000 + (QUOTE LEFT)) (SETQ STRING + (TEDIT.SEL.AS.STRING STREAM)) + (CLOSEF STREAM)) (COND ((LISTP FILENAME) (OPENTEXTSTREAM (CAR FILENAME) @@ -1448,7 +1393,7 @@ The default implementations are given below.) (DEFINEQ (SimpleAnalyzer.Create - [LAMBDA (NAME) (* ; "Edited 14-Sep-88 09:49 by jtm:") + [LAMBDA (NAME) (* ; "Edited 14-Sep-88 09:49 by jtm:") (LET (morphalyzer) (SETQ morphalyzer (create Morphalyzer analyzerName _ NAME @@ -1460,7 +1405,7 @@ The default implementations are given below.) morphalyzer]) (SimpleAnalyzer.Lookup - [LAMBDA (ANALYZER STREAM START LENGTH) (* ; "Edited 14-Sep-88 09:46 by jtm:") + [LAMBDA (ANALYZER STREAM START LENGTH) (* ; "Edited 14-Sep-88 09:46 by jtm:") (L-CASE (COND ((STRINGP STREAM) (SUBSTRING STREAM (ADD1 START) @@ -1470,7 +1415,7 @@ The default implementations are given below.) (DEFINEQ (SimpleDict.Create - [LAMBDA (name filename) (* ; "Edited 15-Sep-88 11:26 by jtm:") + [LAMBDA (name filename) (* ; "Edited 15-Sep-88 11:26 by jtm:") (LET (dict) (SETQ dict (create Dict dictName _ name @@ -1484,18 +1429,17 @@ The default implementations are given below.) dict]) (SimpleDict.Open - [LAMBDA (DICT) (* ; "Edited 15-Sep-88 11:38 by jtm:") + [LAMBDA (DICT) (* ; "Edited 15-Sep-88 11:38 by jtm:") (LET (FILENAME) (COND - ([AND (NULL (fetch (SimpleDict.Node subnodes) of (fetch (Dict contents) - of DICT))) + ([AND (NULL (fetch (SimpleDict.Node subnodes) of (fetch (Dict contents) of DICT))) (SETQ FILENAME (Dict.Prop DICT 'FILENAME] (SETQ DATALIST (CDR (READFILE FILENAME))) (for PAIR in DATALIST do (Dict.PutEntry DICT (CAR PAIR) - (CADR PAIR]) + (CADR PAIR]) (SimpleDict.Close - [LAMBDA (DICT) (* ; "Edited 15-Sep-88 11:30 by jtm:") + [LAMBDA (DICT) (* ; "Edited 15-Sep-88 11:30 by jtm:") (LET (CONTENTS FILENAME) (COND ([AND (SETQ CONTENTS (fetch (Dict contents) of DICT)) @@ -1506,7 +1450,7 @@ The default implementations are given below.) DICT]) (SimpleDict.Write - [LAMBDA (DICT FILENAME) (* ; "Edited 15-Sep-88 11:21 by jtm:") + [LAMBDA (DICT FILENAME) (* ; "Edited 15-Sep-88 11:21 by jtm:") (LET (DATALIST) (COND [(NULL FILENAME) @@ -1514,7 +1458,7 @@ The default implementations are given below.) (T (Dict.Prop DICT 'FILENAME FILENAME))) [SimpleDict.MapEntries DICT (FUNCTION (LAMBDA (DICT PATH ENTRY) (push DATALIST (LIST (CONCATLIST PATH) - ENTRY] + ENTRY] (WRITEFILE (DREVERSE DATALIST) FILENAME) DICT]) @@ -1528,26 +1472,25 @@ The default implementations are given below.) "only" "more" "then" "him" "our" "any" "them" "her" "over" "its" "before" "between" "what" "after" "she" "most" "those" "than" "these" "does" "same" "into" "such" "while" "here" "how" "off" "will" "around" "there")) -(PUTPROPS WORDNERD COPYRIGHT ("Xerox Corporation" 1988)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5746 9213 (WordNerd.AddEntry 5756 . 6713) (WordNerd.AddDictionary 6715 . 7805) ( -WordNerd.AddStopWords 7807 . 8049) (WordNerd.SortByFrequency 8051 . 9211)) (9214 25478 ( -WordNerd.DefaultVennSearch 9224 . 25476)) (25479 38724 (WordNerd.DefaultWeightedSearch 25489 . 34408) -(AddWeightsToArray 34410 . 35287) (FindTopElements 35289 . 36530) (AddToPriorityList 36532 . 38722)) ( -38725 41776 (WordNerd.DefaultRelevanceSearch 38735 . 40149) (MergeKeywords 40151 . 41774)) (41777 -44015 (WORDNERD.PARSEINPUT 41787 . 44013)) (44158 54130 (SimpleNerd.Create 44168 . 45489) ( -SimpleNerd.AddAssociation 45491 . 49412) (SimpleNerd.MapKeys 49414 . 50186) (SimpleNerd.GetEntry 50188 - . 50346) (SimpleNerd.MaxEntry 50348 . 50510) (SimpleNerd.GetHeader 50512 . 50720) ( -SimpleNerd.ParseDictEntry 50722 . 52162) (SimpleNerd.Test 52164 . 54128)) (54209 71892 ( -HashfileNerd.Create 54219 . 56055) (HashfileNerd.Test 56057 . 56625) (HashfileNerd.Open 56627 . 59055) - (HashfileNerd.Close 59057 . 59802) (HashfileNerd.Write 59804 . 63978) (SIMPLETYPE 63980 . 64303) ( -HashfileNerd.AddAssociation 64305 . 68875) (HashfileNerd.GetEntry 68877 . 69535) ( -HashfileNerd.ExpandKeyPattern 69537 . 70869) (HashfileNerd.MapKeys 70871 . 71890)) (71893 75042 ( -BIGHASH 71903 . 72494) (BIGGETHASH 72496 . 72992) (BIGHASHSIZE 72994 . 73532) (BIGMAPHASH 73534 . -74110) (BIGPUTHASH 74112 . 75040)) (75371 78536 (FileDict.Create 75381 . 75899) (FileDict.AddFiles -75901 . 76385) (FileDict.PrintEntry 76387 . 76644) (FileDict.Write 76646 . 76840) (FileDict.Lookup -76842 . 77096) (FileDict.MapEntries 77098 . 77660) (FETCHSTRINGFROMFILE 77662 . 78534)) (78537 79371 ( -SimpleAnalyzer.Create 78547 . 79027) (SimpleAnalyzer.Lookup 79029 . 79369)) (79372 81850 ( -SimpleDict.Create 79382 . 80070) (SimpleDict.Open 80072 . 80680) (SimpleDict.Close 80682 . 81221) ( -SimpleDict.Write 81223 . 81848))))) + (FILEMAP (NIL (4821 8248 (WordNerd.AddEntry 4831 . 5792) (WordNerd.AddDictionary 5794 . 6832) ( +WordNerd.AddStopWords 6834 . 7080) (WordNerd.SortByFrequency 7082 . 8246)) (8249 22710 ( +WordNerd.DefaultVennSearch 8259 . 22708)) (22711 35032 (WordNerd.DefaultWeightedSearch 22721 . 31261) +(AddWeightsToArray 31263 . 32091) (FindTopElements 32093 . 32965) (AddToPriorityList 32967 . 35030)) ( +35033 37928 (WordNerd.DefaultRelevanceSearch 35043 . 36451) (MergeKeywords 36453 . 37926)) (37929 +39990 (WORDNERD.PARSEINPUT 37939 . 39988)) (40133 49749 (SimpleNerd.Create 40143 . 41468) ( +SimpleNerd.AddAssociation 41470 . 45094) (SimpleNerd.MapKeys 45096 . 45874) (SimpleNerd.GetEntry 45876 + . 46034) (SimpleNerd.MaxEntry 46036 . 46198) (SimpleNerd.GetHeader 46200 . 46412) ( +SimpleNerd.ParseDictEntry 46414 . 47860) (SimpleNerd.Test 47862 . 49747)) (49828 67219 ( +HashfileNerd.Create 49838 . 51678) (HashfileNerd.Test 51680 . 52252) (HashfileNerd.Open 52254 . 54794) + (HashfileNerd.Close 54796 . 55545) (HashfileNerd.Write 55547 . 59493) (SIMPLETYPE 59495 . 59822) ( +HashfileNerd.AddAssociation 59824 . 64238) (HashfileNerd.GetEntry 64240 . 64902) ( +HashfileNerd.ExpandKeyPattern 64904 . 66204) (HashfileNerd.MapKeys 66206 . 67217)) (67220 70510 ( +BIGHASH 67230 . 67760) (BIGGETHASH 67762 . 68262) (BIGHASHSIZE 68264 . 68920) (BIGMAPHASH 68922 . +69574) (BIGPUTHASH 69576 . 70508)) (70831 74016 (FileDict.Create 70841 . 71363) (FileDict.AddFiles +71365 . 71838) (FileDict.PrintEntry 71840 . 72101) (FileDict.Write 72103 . 72301) (FileDict.Lookup +72303 . 72561) (FileDict.MapEntries 72563 . 73129) (FETCHSTRINGFROMFILE 73131 . 74014)) (74017 74859 ( +SimpleAnalyzer.Create 74027 . 74511) (SimpleAnalyzer.Lookup 74513 . 74857)) (74860 77266 ( +SimpleDict.Create 74870 . 75562) (SimpleDict.Open 75564 . 76092) (SimpleDict.Close 76094 . 76637) ( +SimpleDict.Write 76639 . 77264))))) STOP diff --git a/lispusers/proofreader/PROOFREADER-WORDNERD.LCOM b/lispusers/proofreader/PROOFREADER-WORDNERD.LCOM new file mode 100644 index 000000000..27965c00a Binary files /dev/null and b/lispusers/proofreader/PROOFREADER-WORDNERD.LCOM differ diff --git a/lispusers/proofreader/PROOFREADER.LCOM b/lispusers/proofreader/PROOFREADER.LCOM new file mode 100644 index 000000000..a7909e4df Binary files /dev/null and b/lispusers/proofreader/PROOFREADER.LCOM differ diff --git a/lispusers/proofreader/README.TXT b/lispusers/proofreader/README.TXT new file mode 100644 index 000000000..ec21897fa Binary files /dev/null and b/lispusers/proofreader/README.TXT differ