SystemOrganization addCategory: #'TextLint-Model'! SystemOrganization addCategory: #'TextLint-Model-Parser'! SystemOrganization addCategory: #'TextLint-Model-Rules'! SystemOrganization addCategory: #'TextLint-Model-Runner'! PPCompositeParser subclass: #TLDocumentPhraser instanceVariableNames: 'document documentTerminator paragraph paragraphTerminator sentence sentenceTerminator' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLDocumentPhraser methodsFor: 'grammar' stamp: 'lr 11/3/2010 16:28'! document ^ (paragraph starLazy: documentTerminator) , (documentTerminator optional)! ! !TLDocumentPhraser methodsFor: 'grammar' stamp: 'JorgeRessia 6/12/2010 12:19'! documentTerminator ^ PPPredicateObjectParser on: [ :token | token isEndOfDocument ] message: 'End of document expected'! ! !TLDocumentPhraser methodsFor: 'grammar' stamp: 'lr 11/3/2010 16:28'! paragraph ^ (sentence starLazy: paragraphTerminator / documentTerminator) , (paragraphTerminator optional) ! ! !TLDocumentPhraser methodsFor: 'grammar' stamp: 'JorgeRessia 6/12/2010 12:20'! paragraphTerminator ^ PPPredicateObjectParser on: [ :token | token isWhitespace and: [ token isEndOfParagraph ] ] message: 'End of paragraph expected'! ! !TLDocumentPhraser methodsFor: 'grammar' stamp: 'lr 11/3/2010 16:29'! sentence ^ (#any asParser starLazy: sentenceTerminator / paragraphTerminator / documentTerminator) , (sentenceTerminator optional)! ! !TLDocumentPhraser methodsFor: 'grammar' stamp: 'JorgeRessia 6/12/2010 12:20'! sentenceTerminator ^ PPPredicateObjectParser on: [ :token | token isPunctuation and: [ token isEndOfSentence ] ] message: 'End of sentence expected'! ! !TLDocumentPhraser methodsFor: 'accessing' stamp: 'lr 4/6/2010 21:43'! start ^ document end! ! TLDocumentPhraser subclass: #TLTextPhraser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLTextPhraser methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:28'! document ^ super document ==> [ :nodes | TLDocument withAll: nodes first ]! ! !TLTextPhraser methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:28'! paragraph ^ super paragraph ==> [ :nodes | TLParagraph withAll: (nodes last isNil ifFalse: [ nodes first copyWith: nodes last ] ifTrue: [ nodes first ]) ]! ! !TLTextPhraser methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:29'! sentence ^ super sentence ==> [ :nodes | TLSentence withAll: (nodes last isNil ifFalse: [ nodes first copyWith: nodes last ] ifTrue: [ nodes first ]) ]! ! PPCompositeParser subclass: #TLTextTokenizer instanceVariableNames: 'elementList element markup word whitespace punctuation punctuationGroups' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! TLTextTokenizer subclass: #TLPatternTokenizer instanceVariableNames: '' classVariableNames: 'Instance' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLPatternTokenizer class methodsFor: 'instance creation' stamp: 'lr 5/4/2011 23:18'! newStartingAt: aSymbol ^ Instance ifNil: [ Instance := super newStartingAt: aSymbol ]! ! !TLPatternTokenizer methodsFor: 'accessing' stamp: 'JorgeRessia 11/3/2010 23:02'! elementList ^ super elementList foldLeft: [ :a :b | a , b ]! ! !TLPatternTokenizer methodsFor: 'accessing' stamp: 'lr 5/4/2011 20:47'! markup ^ ${ asParser , #word asParser plus flatten , $} asParser map: [ :open :token :close | | type | type := token asSymbol. (TLWordClassifier types includes: type) ifFalse: [ PPFailure message: 'Invalid word type: ' , token ] ifTrue: [ PPPredicateObjectParser on: [ :each | each isWord and: [ each classification includes: type ] ] message: token , ' expected' ] ]! ! !TLPatternTokenizer methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:38'! punctuation ^ super punctuation ==> [ :token | PPPredicateObjectParser on: [ :each | each isPunctuation and: [ each text sameAs: token value ] ] message: token value printString , ' expected' ]! ! !TLPatternTokenizer methodsFor: 'accessing' stamp: 'lr 11/30/2010 19:38'! whitespace ^ super whitespace ==> [ :token | (PPPredicateObjectParser on: [ :each | each isWhitespace or: [ each isMarkup ] ] message: 'whitespace expected') star ]! ! !TLPatternTokenizer methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:36'! word ^ super word ==> [ :token | PPPredicateObjectParser on: [ :each | each isWord and: [ each text sameAs: token value ] ] message: token value printString , ' expected' ]! ! TLTextTokenizer subclass: #TLPlainTokenizer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! TLPlainTokenizer subclass: #TLHtmlTokenizer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLHtmlTokenizer methodsFor: 'tokens' stamp: 'lr 5/31/2010 07:38'! markup ^ (($< asParser , $> asParser negate plus , $> asParser) / ($& asParser , $; asParser negate plus , $; asParser)) token ==> [ :token | TLMarkup with: token ]! ! TLPlainTokenizer subclass: #TLLatexTokenizer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLLatexTokenizer methodsFor: 'private' stamp: 'lr 5/31/2010 07:36'! consumeCommand: aStream | counter char | ('{[' includes: aStream peek) ifFalse: [ ^ self ]. counter := 0. [ char := aStream next. (char = ${ or: [ char = $[ ]) ifTrue: [ counter := counter + 1 ] ifFalse: [ (char = $} or: [ char = $] ]) ifTrue: [ counter := counter - 1 ] ]. aStream atEnd or: [ counter = 0 ] ] whileFalse. self consumeCommand: aStream! ! !TLLatexTokenizer methodsFor: 'private' stamp: 'lr 5/31/2010 07:35'! consumeEnvironment: aStream aStream upToAll: '\end{' , (aStream upTo: $}) , '}'! ! !TLLatexTokenizer methodsFor: 'configuration' stamp: 'lr 9/30/2010 08:27'! ignoredCommands ^ #('newcommand' 'renewcommand' 'newenviornment' 'lstset' 'index') asSet asParser! ! !TLLatexTokenizer methodsFor: 'configuration' stamp: 'lr 5/31/2010 07:34'! ignoredEnvironments ^ #('lstlisting' 'figure' 'table') asSet asParser! ! !TLLatexTokenizer methodsFor: 'tokens' stamp: 'JorgeRessia 6/12/2010 12:18'! markup ^ ((PPPredicateObjectParser anyOf: '{}[]`-') / ('\begin{' asParser , self ignoredEnvironments and , [ :stream | self consumeEnvironment: stream ] asParser) / ($\ asParser , self ignoredCommands , [ :stream | self consumeCommand: stream ] asParser) / ($\ asParser , #any asParser , #word asParser star) / ($% asParser , #newline asParser negate star)) token ==> [ :token | TLMarkup with: token ]! ! !TLLatexTokenizer methodsFor: 'tokens' stamp: 'lr 5/28/2010 12:00'! punctuationGroups ^ super punctuationGroups / '``' asParser / '''''' asParser! ! !TLPlainTokenizer methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:31'! elementList ^ super elementList ==> [ :nodes | nodes copyWith: (TLTerminatorMark with: '') ]! ! !TLPlainTokenizer methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:32'! punctuation ^ super punctuation ==> [ :node | TLPunctuationMark with: node ]! ! !TLPlainTokenizer methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:33'! whitespace ^ super whitespace ==> [ :node | TLWhitespace with: node ]! ! !TLPlainTokenizer methodsFor: 'accessing' stamp: 'lr 11/3/2010 16:32'! word ^ super word ==> [ :node | TLWord with: node ]! ! !TLTextTokenizer methodsFor: 'grammar' stamp: 'lr 5/27/2010 16:26'! element ^ markup / word / whitespace / punctuation! ! !TLTextTokenizer methodsFor: 'grammar' stamp: 'lr 11/3/2010 16:31'! elementList ^ element star! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'lr 5/27/2010 16:27'! markup ^ PPFailingParser message: 'Markup expected'! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'lr 11/3/2010 16:31'! punctuation ^ (punctuationGroups / #any asParser) token! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'lr 5/28/2010 11:59'! punctuationGroups ^ '...' asParser! ! !TLTextTokenizer methodsFor: 'accessing' stamp: 'lr 4/6/2010 20:21'! start ^ elementList end! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'lr 11/3/2010 16:32'! whitespace ^ #space asParser plus token! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'lr 11/3/2010 16:32'! word ^ #word asParser plus token! ! Object subclass: #TLElement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! TLElement subclass: #TLDocument instanceVariableNames: 'paragraphs' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLDocument class methodsFor: 'instance creation' stamp: 'lr 3/31/2010 11:15'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLDocument methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 09:27'! allElements ^OrderedCollection new add: self; addAll: paragraphs; addAll: self sentences; addAll: self words; yourself.! ! !TLDocument methodsFor: 'checking' stamp: 'JorgeRessia 5/26/2010 10:12'! checkWith: aTextLintChecker ^aTextLintChecker checkDocument: self! ! !TLDocument methodsFor: 'accessing' stamp: 'lr 4/6/2010 21:15'! children ^ paragraphs! ! !TLDocument methodsFor: 'initialization' stamp: 'lr 3/31/2010 11:16'! initializeWithAll: aCollection paragraphs := aCollection! ! !TLDocument methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 12:11'! isDocument ^ true! ! !TLDocument methodsFor: 'accessing' stamp: 'lr 3/31/2010 11:22'! paragraphs ^paragraphs ! ! !TLDocument methodsFor: 'visiting' stamp: 'JorgeRessia 6/16/2010 15:30'! processFor: aVisitor ^ aVisitor processDocument: self! ! !TLDocument methodsFor: 'accessing' stamp: 'lr 3/31/2010 11:24'! sentences ^ self paragraphs gather: [ :each | each sentences ]! ! !TLDocument methodsFor: 'accessing' stamp: 'lr 3/31/2010 11:24'! words ^self sentences gather: [ :each | each words ]! ! !TLElement methodsFor: 'checking' stamp: 'lr 5/27/2010 16:25'! checkWith: aTextLintChecker self subclassResponsibility! ! !TLElement methodsFor: 'accessing' stamp: 'lr 4/6/2010 20:30'! children "Answer the children nodes." ^ #() ! ! !TLElement methodsFor: 'accessing' stamp: 'lr 4/9/2010 10:54'! interval "Answer the interval in the text in which the receiver is defined." ^ self start to: self stop! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 12:11'! isDocument ^ false! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 11:44'! isEndOfDocument ^ false! ! !TLElement methodsFor: 'testing' stamp: 'lr 5/27/2010 16:24'! isMarkup ^ false! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 12:11'! isParagraph ^ false! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/9/2010 14:06'! isPhrase ^ false! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 11:44'! isPunctuation ^ false! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 12:10'! isSentence ^ false! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 11:44'! isWhitespace ^ false! ! !TLElement methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 11:44'! isWord ^ false! ! !TLElement methodsFor: 'printing' stamp: 'JorgeRessia 4/8/2010 10:49'! printContentOn: aStream self children do: [ :each | aStream nextPutAll: each text ]! ! !TLElement methodsFor: 'printing' stamp: 'lr 4/8/2010 13:29'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' ('. self printContentOn: aStream. aStream nextPut: $)! ! !TLElement methodsFor: 'accessing' stamp: 'lr 4/9/2010 10:56'! start "Answer the start position of the receiver." ^ self children isEmpty ifFalse: [ self children first start ] ifTrue: [ 1 ]! ! !TLElement methodsFor: 'accessing' stamp: 'lr 4/9/2010 11:02'! stop "Answer the end position of the receiver." ^ self children isEmpty ifFalse: [ self children last stop ] ifTrue: [ 0 ]! ! !TLElement methodsFor: 'accessing' stamp: 'lr 4/6/2010 22:09'! text ^ String streamContents: [ :stream | self printContentOn: stream ]! ! !TLElement methodsFor: 'accessing' stamp: 'lr 6/16/2010 08:18'! token "Answer the first token in the receiver or nil." ^ self children isEmpty ifFalse: [ self children first token ]! ! TLElement subclass: #TLParagraph instanceVariableNames: 'sentences' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLParagraph class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/7/2010 11:13'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLParagraph methodsFor: 'checking' stamp: 'JorgeRessia 5/26/2010 10:20'! checkWith: aTextLintChecker ^aTextLintChecker checkParagraph: self! ! !TLParagraph methodsFor: 'accessing' stamp: 'lr 4/6/2010 21:15'! children ^ sentences! ! !TLParagraph methodsFor: 'initialization' stamp: 'lr 3/31/2010 11:17'! initializeWithAll: aCollection sentences := aCollection! ! !TLParagraph methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 12:11'! isParagraph ^ true! ! !TLParagraph methodsFor: 'visiting' stamp: 'JorgeRessia 6/16/2010 15:30'! processFor: aVisitor ^ aVisitor processParagraph: self! ! !TLParagraph methodsFor: 'accessing' stamp: 'JorgeRessia 4/7/2010 11:13'! sentences ^sentences reject: [:eachElement | eachElement isWhitespace]! ! !TLParagraph methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 10:48'! words ^self sentences gather: [ :each | each words ]! ! TLElement subclass: #TLPhrase instanceVariableNames: 'syntacticElements' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLPhrase class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/8/2010 14:52'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLPhrase methodsFor: 'accessing' stamp: 'JorgeRessia 4/8/2010 14:57'! children ^ syntacticElements! ! !TLPhrase methodsFor: 'initialization' stamp: 'JorgeRessia 4/8/2010 14:56'! initializeWithAll: aCollection syntacticElements := aCollection! ! !TLPhrase methodsFor: 'testing' stamp: 'JorgeRessia 4/9/2010 14:06'! isPhrase ^ true! ! !TLPhrase methodsFor: 'accessing' stamp: 'JorgeRessia 9/3/2010 10:04'! phraseWithoutMarkups ^ TLPhrase withAll: (syntacticElements select: [:eachToken | eachToken isMarkup not ])! ! !TLPhrase methodsFor: 'visiting' stamp: 'JorgeRessia 6/16/2010 15:31'! processFor: aVisitor ^ aVisitor processPhrase: self! ! !TLPhrase methodsFor: 'accessing' stamp: 'JorgeRessia 9/23/2010 22:02'! size ^self words size! ! !TLPhrase methodsFor: 'accessing' stamp: 'JorgeRessia 4/8/2010 14:56'! words ^ syntacticElements select: [:eachToken | eachToken isWord ]! ! TLElement subclass: #TLSentence instanceVariableNames: 'syntacticElements phrasesCache sequencesCache' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLSentence class methodsFor: 'instance creation' stamp: 'lr 3/31/2010 11:17'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLSentence methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 13:49'! allPhrasesOfSize: aSmallInteger | phrases words | phrasesCache at: aSmallInteger ifPresent: [:element | ^element]. phrases := OrderedCollection new. words := self words. 1 to: words size do: [ :index | ((index + aSmallInteger - 1) <= words size) ifTrue: [ phrases add: (TLPhrase withAll: ( syntacticElements copyFrom: (syntacticElements indexOf: (words at: index )) to: (syntacticElements indexOf: (words at: index + aSmallInteger - 1))))] ifFalse: [ phrasesCache at: aSmallInteger put: phrases. ^phrases] ]. phrasesCache at: aSmallInteger put: phrases. ^phrases ! ! !TLSentence methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 15:45'! allSequencesOfSize: aSmallInteger | sequences children| sequencesCache at: aSmallInteger ifPresent: [:element | ^element]. sequences := OrderedCollection new. children := self children. 1 to: children size do: [ :index | ((index + aSmallInteger - 1) <= children size) ifTrue: [ sequences add: (TLPhrase withAll: ( syntacticElements copyFrom: (syntacticElements indexOf: (children at: index )) to: (syntacticElements indexOf: (children at: index + aSmallInteger - 1))))] ifFalse: [ sequencesCache at: aSmallInteger put: sequences. ^sequences] ]. sequencesCache at: aSmallInteger put: sequences. ^sequences ! ! !TLSentence methodsFor: 'checking' stamp: 'JorgeRessia 5/26/2010 10:41'! checkWith: aTextLintChecker ^aTextLintChecker checkSentence: self! ! !TLSentence methodsFor: 'accessing' stamp: 'JorgeRessia 4/8/2010 11:08'! children ^ syntacticElements! ! !TLSentence methodsFor: 'testing' stamp: 'lr 4/5/2010 10:25'! containsPhrase: aString ^ self wordsAsString includesSubstring: aString caseSensitive: false! ! !TLSentence methodsFor: 'initialization' stamp: 'JorgeRessia 6/10/2010 15:30'! initializeWithAll: aCollection syntacticElements := aCollection. phrasesCache := Dictionary new. sequencesCache := Dictionary new.! ! !TLSentence methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 12:12'! isSentence ^ true! ! !TLSentence methodsFor: 'visiting' stamp: 'JorgeRessia 6/16/2010 15:31'! processFor: aVisitor ^ aVisitor processSentence: self! ! !TLSentence methodsFor: 'accessing' stamp: 'JorgeRessia 4/8/2010 11:08'! words ^ syntacticElements select: [:eachToken | eachToken isWord ]! ! !TLSentence methodsFor: 'accessing' stamp: 'JorgeRessia 4/7/2010 15:24'! wordsAsString ^self words inject: '' into: [:count :each | count, ' ', each text] ! ! TLElement subclass: #TLSyntacticElement instanceVariableNames: 'token' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! TLSyntacticElement subclass: #TLMarkup instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLMarkup methodsFor: 'testing' stamp: 'lr 5/27/2010 16:24'! isMarkup ^ true! ! TLSyntacticElement subclass: #TLPunctuationMark instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLPunctuationMark methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 13:58'! isEndOfSentence ^ '.:;!!?' includes: (token collection at: token start)! ! !TLPunctuationMark methodsFor: 'testing' stamp: 'lr 4/6/2010 20:44'! isPunctuation ^ true! ! !TLSyntacticElement class methodsFor: 'instance creation' stamp: 'lr 4/8/2010 13:31'! with: aToken ^ self new initializeWith: aToken! ! !TLSyntacticElement methodsFor: 'initialization' stamp: 'lr 4/8/2010 13:31'! initializeWith: aToken token := aToken! ! !TLSyntacticElement methodsFor: 'printing' stamp: 'lr 4/8/2010 13:52'! printContentOn: aStream aStream nextPutAll: self text! ! !TLSyntacticElement methodsFor: 'visiting' stamp: 'JorgeRessia 6/16/2010 15:32'! processFor: aVisitor ^ aVisitor processSyntacticElement: self! ! !TLSyntacticElement methodsFor: 'accessing' stamp: 'lr 4/9/2010 10:57'! start ^ self token start! ! !TLSyntacticElement methodsFor: 'accessing' stamp: 'lr 4/9/2010 10:57'! stop ^ self token stop! ! !TLSyntacticElement methodsFor: 'accessing' stamp: 'JorgeRessia 4/7/2010 13:54'! text ^ token value! ! !TLSyntacticElement methodsFor: 'accessing' stamp: 'JorgeRessia 4/8/2010 10:56'! token ^ token! ! TLSyntacticElement subclass: #TLTerminatorMark instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLTerminatorMark methodsFor: 'testing' stamp: 'lr 4/6/2010 22:04'! isEndOfDocument ^ true! ! TLSyntacticElement subclass: #TLWhitespace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLWhitespace class methodsFor: 'instance creation' stamp: 'JorgeRessia 5/9/2010 11:06'! new ^self basicNew initializeWith: (PPToken on: ' ') ! ! !TLWhitespace methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 15:09'! isEndOfParagraph token start to: token stop do: [ :index | (String crlf includes: (token collection at: index)) ifTrue: [ ^ true ] ]. ^ false! ! !TLWhitespace methodsFor: 'testing' stamp: 'lr 4/6/2010 21:45'! isWhitespace ^ true! ! TLSyntacticElement subclass: #TLWord instanceVariableNames: 'type' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLWord methodsFor: 'checking' stamp: 'lr 5/26/2010 14:17'! checkWith: aTextLintChecker ^ aTextLintChecker checkWord: self! ! !TLWord methodsFor: 'accessing' stamp: 'lr 5/4/2011 20:47'! classification ^ TLWordClassifier classify: self text! ! !TLWord methodsFor: 'testing' stamp: 'lr 4/6/2010 20:44'! isWord ^ true! ! Object subclass: #TLMassPaperAnalysis instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Runner'! !TLMassPaperAnalysis class methodsFor: 'tools' stamp: 'lr 6/11/2010 15:28'! analyzeAllHistory: aDirectory "self analyzeAllHistory: (FileDirectory on: '/Users/renggli/University/git/papers/TextLint/TextLint-IWST2010/casestudy')" aDirectory directoryNames asSortedCollection do: [ :each | self analyzeHistory: (aDirectory directoryNamed: each) ] displayingProgress: 'Analyzing Directories'! ! !TLMassPaperAnalysis class methodsFor: 'tools' stamp: 'lr 9/8/2010 18:46'! analyzeEffectiveness: aDirectory "self analyzeEffectiveness: (FileDirectory on: '/Users/renggli/University/git/papers/TextLint/TextLint-IWST2010/casestudy')" | checker results | checker := TLTextLintChecker new. results := OrderedCollection new. (TLWritingStyle scientificPaperStyle rules asSortedCollection: [ :a :b | a name < b name ]) do: [ :each | checker addRule: each ]. (aDirectory fileNames asSortedCollection select: [ :each | each endsWith: '.txt' ]) do: [ :filename | | stream count last size average | stream := MultiByteFileStream new initialize. stream open: (aDirectory fullNameFor: filename) forWrite: false. stream nextLine. count := 0. average := Array new: checker rules size + 1 withAll: 0. [ stream atEnd ] whileFalse: [ count := count + 1. last := stream nextLine splitOn: String tab. size := (last at: 3) asNumber asFloat. last := (last allButFirst: 3) collect: [ :each | each asNumber / size ]. average keysAndValuesDo: [ :key :value | average at: key put: value + (last at: key) ] ]. average keysAndValuesDo: [ :key :value | average at: key put: value / count asFloat ]. results addLast: (Array with: filename) , (Array streamContents: [ :output | average with: last do: [ :a :l | output nextPut: (a isZero ifTrue: [ 0 ] ifFalse: [ (100.0 - (100.0 * l / a)) rounded ]) ] ]) ] displayingProgress: 'Calculating Effectiveness'. FileStream forceNewFileNamed: (aDirectory containingDirectory fullNameFor: 'casestudy-effectiveness/effectiveness.txt') do: [ :stream | stream nextPutAll: 'Filename'; tab; nextPutAll: 'Total'; tab. checker rules do: [ :rule | stream nextPutAll: rule name ] separatedBy: [ stream tab ]. stream cr. results do: [ :row | row do: [ :col | stream nextPutAll: col asString ] separatedBy: [ stream tab ] ] separatedBy: [ stream cr ] ]. ^ results! ! !TLMassPaperAnalysis class methodsFor: 'tools' stamp: 'lr 11/3/2010 16:28'! analyzeHistory: aDirectory "self analyzeHistory: (FileDirectory on: '/Users/renggli/University/git/papers/TextLint/TextLint-IWST2010/casestudy-history/petitparser')" "self analyzeHistory: (FileDirectory on: '/Users/renggli/University/git/papers/TextLint/TextLint-IWST2010/casestudy-history/J2EE')" "self analyzeHistory: (FileDirectory on: '/Users/renggli/University/git/papers/TextLint/TextLint-IWST2010/casestudy-history/cop')" "self analyzeHistory: (FileDirectory on: '/Users/renggli/University/git/papers/TextLint/TextLint-IWST2010/casestudy-history/pinocchio')" | checker results | checker := TLTextLintChecker new. results := OrderedCollection new. (TLWritingStyle scientificPaperStyle rules asSortedCollection: [ :a :b | a name < b name ]) do: [ :each | checker addRule: each ]. aDirectory fileNames asSortedCollection do: [ :filename | | stream contents document failures | stream := MultiByteFileStream new initialize. stream open: (aDirectory fullNameFor: filename) forWrite: false. contents := [ stream basicNext: stream size ] ensure: [ stream close ]. document := TLTextPhraser parse: (TLLatexTokenizer parse: contents). failures := document allElements gather: [ :each | each checkWith: checker ]. results addLast: (Array with: (filename) with: (contents size) with: (document sentences detectSum: [ :sentence | sentence children detectSum: [ :element | element class = TLMarkup ifTrue: [ 0 ] ifFalse: [ element token size ] ] ]) with: (failures size)) , (checker rules collect: [ :each | failures count: [ :failure | failure rule == each ] ]) ] displayingProgress: 'Analyzing History'. FileStream forceNewFileNamed: (aDirectory containingDirectory fullNameFor: aDirectory localName , '.txt') do: [ :stream | stream nextPutAll: 'Filename'; tab; nextPutAll: 'Filesize'; tab; nextPutAll: 'Textsize'; tab; nextPutAll: 'Failures'; tab. checker rules do: [ :rule | stream nextPutAll: rule name ] separatedBy: [ stream tab ]. stream cr. results do: [ :row | row do: [ :col | stream nextPutAll: col asString ] separatedBy: [ stream tab ] ] separatedBy: [ stream cr ] ]. ^ results! ! !TLMassPaperAnalysis methodsFor: 'private' stamp: 'FabrizioPerin 7/30/2010 09:36'! analyze | paperNames allFailures aChecker file fileContents results author| aChecker := TLTextLintChecker new. TLWritingStyle scientificPaperStyle rules do: [:rule | aChecker addRule: rule]. allFailures := Dictionary new. paperNames := (FileDirectory on: '/Users/ressia/temp/Papers/Helvetia') fullNamesOfAllFilesInSubtree select: [:each | each endsWith: '.tex']. paperNames do: [:each | fileContents := (StandardFileStream readOnlyFileNamed: each) contentsOfEntireFile. fileContents := (fileContents copyReplaceAll: String crlf with: String cr) copyReplaceAll: String lf with: String cr. author := nil. (fileContents findString: '% $Author:' startingAt: 1 ) = 0 ifFalse: [author := fileContents copyFrom: (fileContents findString: '% $Author:' startingAt: 1 ) to: (fileContents findDelimiters: '$' startingAt: (fileContents findString: '% $Author:' startingAt: 1 ) )]. (fileContents findString: '\author{' startingAt: 1 ) = 0 ifFalse: [author := fileContents copyFrom: (fileContents findString: '\author{' startingAt: 1 ) to: (fileContents findDelimiters: '}' startingAt: (fileContents findString: '\author{' startingAt: 1 ) )]. results := aChecker check: fileContents. allFailures at: each put: results]. file := CrLfFileStream forceNewFileNamed: '/Users/ressia/temp/SCGPapersTextLintFailures.txt'. ^ allFailures keysAndValuesDo: [:key :value | value do: [:eachFailure | file nextPutAll: key; nextPutAll: ' '; nextPutAll: author asString; nextPutAll: ' '; nextPutAll: eachFailure rule class name; nextPutAll: ' '; nextPutAll: eachFailure element text; nextPutAll: ' ']] ! ! Object subclass: #TLPhrasePatternRulesContainer instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! Object subclass: #TLRuleFailure instanceVariableNames: 'rule element' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Runner'! !TLRuleFailure class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/6/2010 15:54'! on: aRule at: anElement ^self new initializeOn: aRule at: anElement! ! !TLRuleFailure methodsFor: 'accessing' stamp: 'JorgeRessia 4/6/2010 16:00'! element ^ element! ! !TLRuleFailure methodsFor: 'initialization' stamp: 'JorgeRessia 4/6/2010 15:55'! initializeOn: aRule at: anElement rule := aRule. element := anElement! ! !TLRuleFailure methodsFor: 'testing' stamp: 'JorgeRessia 5/26/2010 11:40'! isRuleFailure ^true! ! !TLRuleFailure methodsFor: 'printing' stamp: 'lr 4/8/2010 15:36'! printOn: aStream super printOn: aStream. aStream cr; tab; print: self rule. aStream cr; tab; print: self element! ! !TLRuleFailure methodsFor: 'accessing' stamp: 'JorgeRessia 4/6/2010 16:00'! rule ^ rule! ! Object subclass: #TLTextLintChecker instanceVariableNames: 'rules document' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Runner'! !TLTextLintChecker methodsFor: 'accessing' stamp: 'JorgeRessia 3/31/2010 16:49'! addRule: aRule rules add: aRule! ! !TLTextLintChecker methodsFor: 'accessing' stamp: 'lr 10/25/2010 19:40'! addStyle: aStyle aStyle rules do: [ :each | self addRule: each ]! ! !TLTextLintChecker methodsFor: 'public' stamp: 'lr 11/3/2010 16:32'! check: aString ^ self check: aString tokenizer: ( (#('\documentclass' '\usepackage' '\section' '\begin{') anySatisfy: [ :each | aString includesSubString: each ]) ifTrue: [ TLLatexTokenizer ] ifFalse: [ (#(' self repetitionLimit ifTrue: [ results addAll: phrases ] ]! ! !TLConnectorRepetitionInParagraphRule methodsFor: 'running' stamp: 'lr 5/4/2011 20:02'! checkWordsIn: aParagraph addingFailuresTo: results | failingWords value wordsCounter | wordsCounter := Dictionary new. failingWords := OrderedCollection new. aParagraph words do: [ :eachWord | value := wordsCounter at: eachWord text ifAbsentPut: [ 0 ]. wordsCounter at: eachWord text put: value + 1 ]. wordsCounter keysAndValuesDo: [ :aKey :aValue | (aValue > self repetitionLimit and: [ self connectorWords includes: aKey ]) ifTrue: [ failingWords add: aKey ] ]. aParagraph words do: [ :eachWord | (failingWords includes: eachWord text) ifTrue: [ results add: eachWord ] ]! ! !TLConnectorRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/23/2010 22:01'! connectorPhrases | phrases aPhrase elements | phrases := OrderedCollection new. elements := OrderedCollection new. elements add: (TLWord with: (PPToken on: 'in')). elements add: (TLWhitespace new). elements add: (TLWord with: (PPToken on: 'contrast')). elements add: (TLWhitespace new). elements add: (TLWord with: (PPToken on: 'to')). aPhrase := TLPhrase withAll: elements. phrases add: aPhrase. elements := OrderedCollection new. elements add: (TLWord with: (PPToken on: 'in')). elements add: (TLWhitespace new). elements add: (TLWord with: (PPToken on: 'addition')). aPhrase := TLPhrase withAll: elements. phrases add: aPhrase. elements := OrderedCollection new. elements add: (TLWord with: (PPToken on: 'on')). elements add: (TLWhitespace new). elements add: (TLWord with: (PPToken on: 'the')). elements add: (TLWhitespace new). elements add: (TLWord with: (PPToken on: 'other')). elements add: (TLWhitespace new). elements add: (TLWord with: (PPToken on: 'hand')). aPhrase := TLPhrase withAll: elements. phrases add: aPhrase. ^ phrases! ! !TLConnectorRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/23/2010 21:16'! connectorWords ^ #('however' 'furthermore' 'still' 'nevertheless')! ! !TLConnectorRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/23/2010 21:11'! name ^ 'Avoid connectors repetition'! ! !TLConnectorRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:40'! rationale ^ 'The constant repetition of the same connectors in a paragraph is weakening.'! ! !TLConnectorRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/23/2010 21:56'! repetitionLimit ^1! ! !TLConnectorRepetitionInParagraphRule methodsFor: 'running' stamp: 'JorgeRessia 9/29/2010 09:55'! runOnParagraph: aParagraph | results failures | results := OrderedCollection new. self checkWordsIn: aParagraph addingFailuresTo: results. self checkPhrasesIn: aParagraph addingFailuresTo: results. failures := OrderedCollection new. results do: [:each | failures add: (TLRuleFailure on: self at: each) ]. ^ failures! ! TLTextLintRule subclass: #TLJoinedSentencesWithCommasRule instanceVariableNames: 'wordsBeforeCommaExceptions' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLJoinedSentencesWithCommasRule methodsFor: 'initialization' stamp: 'JorgeRessia 5/27/2010 16:55'! initialize super initialize. self initializeWordsBeforeComma! ! !TLJoinedSentencesWithCommasRule methodsFor: 'initialization' stamp: 'lr 5/30/2010 19:27'! initializeWordsBeforeComma wordsBeforeCommaExceptions := OrderedCollection new add: 'or'; add: 'and'; add: 'since'; add: 'however'; add: 'but'; add: 'because'; add: 'though'; add: 'still'; add: 'yet'; add: 'as'; yourself.! ! !TLJoinedSentencesWithCommasRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid joined sentences'! ! !TLJoinedSentencesWithCommasRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:40'! rationale ^ 'Do not join sentences with commas, instead use colons, semi-colons, dashes, or conjunctions.'! ! !TLJoinedSentencesWithCommasRule methodsFor: 'running' stamp: 'JorgeRessia 5/27/2010 17:05'! runOnSentence: aSentence | results numberOfCommas children commaIndex wordsBeforeComma wordsAfterComma | results := OrderedCollection new. children := aSentence children. numberOfCommas := children inject: 0 into: [:count :each | (each text = ',') ifTrue: [ count + 1 ] ifFalse: [ count ]]. (numberOfCommas = 1) ifFalse: [^results]. commaIndex := children indexOf: (children detect: [:each | each isPunctuation and: [each text = ',']]). wordsAfterComma := children select: [:each | each isWord and: [ (children indexOf: each) > commaIndex ]]. (wordsAfterComma size > 0 ) ifFalse: [^results]. (self wordsBeforeComma anySatisfy: [:each | wordsAfterComma first text sameAs: each] ) ifTrue: [^results]. wordsBeforeComma := children select: [:each | each isWord and: [ (children indexOf: each) < commaIndex ]]. ((wordsBeforeComma size > 4) and: [wordsAfterComma size > 4]) ifTrue: [ results add: (TLRuleFailure on: self at: aSentence) ]. ^results ! ! !TLJoinedSentencesWithCommasRule methodsFor: 'initialization' stamp: 'JorgeRessia 5/27/2010 17:03'! wordsBeforeComma ^wordsBeforeCommaExceptions ! ! TLTextLintRule subclass: #TLLongParagraphRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLLongParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/28/2010 11:17'! maxSentencesPerParagraph ^10! ! !TLLongParagraphRule methodsFor: 'running' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid long paragraph'! ! !TLLongParagraphRule methodsFor: 'accessing' stamp: 'lr 11/30/2010 19:39'! rationale ^ 'Paragraphs with more than ' , self maxSentencesPerParagraph asString , ' sentences are too long, they should be split into multiple paragraphs.'! ! !TLLongParagraphRule methodsFor: 'running' stamp: 'JorgeRessia 5/28/2010 11:17'! runOnParagraph: aParagraph | results | results := OrderedCollection new. (aParagraph sentences size > self maxSentencesPerParagraph ) ifTrue: [results add: (TLRuleFailure on: self at: aParagraph)]. ^results ! ! TLTextLintRule subclass: #TLLongSentenceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLLongSentenceRule methodsFor: 'accessing' stamp: 'lr 5/28/2010 11:50'! maxWordsPerSentence ^ 40! ! !TLLongSentenceRule methodsFor: 'running' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid long sentence'! ! !TLLongSentenceRule methodsFor: 'accessing' stamp: 'lr 11/30/2010 19:39'! rationale ^ 'Sentences of more than ' , self maxWordsPerSentence asString , ' words are too long, they should be split into multiple sentences.'! ! !TLLongSentenceRule methodsFor: 'running' stamp: 'JorgeRessia 5/28/2010 10:40'! runOnSentence: aSentence | results | results := OrderedCollection new. (aSentence words size > self maxWordsPerSentence ) ifTrue: [results add: (TLRuleFailure on: self at: aSentence)]. ^results ! ! TLTextLintRule subclass: #TLPatternRule instanceVariableNames: 'pattern' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! TLPatternRule subclass: #TLALotRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLALotRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:38'! matchingString ^ 'a lot'! ! !TLALotRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:47'! name ^ 'Avoid "a lot"'! ! !TLALotRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:41'! rationale ^ 'Avoid using "a lot", it weakens the sentence.'! ! TLPatternRule subclass: #TLARule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLARule methodsFor: 'private' stamp: 'lr 10/31/2010 14:34'! exceptions ^ #('union' 'united' 'unified' 'unifying' 'us' 'one' 'unit' 'user' 'usage' 'universal' 'unique' 'unit' 'useful' 'uniform')! ! !TLARule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:45'! matchingPattern ^ (self word: 'a') , (self separators) , (self wordIn: self exceptions) not , (self wordSatisfying: [ :value | value first isVowel ])! ! !TLARule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid "a"'! ! !TLARule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:37'! rationale ^ 'After "a" only words beginning without a vowel are allowed.'! ! TLPatternRule subclass: #TLAllowToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAllowToRule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:03'! matchingPattern ^ (self word: 'allow') / (self word: 'allows') , (self separators) , (self word: 'to')! ! !TLAllowToRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:53'! name ^ 'Avoid "allow to"'! ! !TLAllowToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/4/2010 10:19'! rationale ^ 'Never use the expressions "allow/s to". This expression requires a direct object.'! ! TLPatternRule subclass: #TLAnRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAnRule methodsFor: 'private' stamp: 'lr 10/31/2010 14:37'! exceptions ^ #('honorable' 'honest' 'hour' 'xml' 'hybrid' 'html' 'http')! ! !TLAnRule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:45'! matchingPattern ^ (self word: 'an') , (self separators) , (self wordIn: self exceptions) not , (self wordSatisfying: [ :value | value first isVowel not ])! ! !TLAnRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid "an"'! ! !TLAnRule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:37'! rationale ^ 'After "an" only words beginning with a vowel are allowed.'! ! TLPatternRule subclass: #TLAsToWhetherRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:38'! matchingString ^ 'as to whether'! ! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'JorgeRessia 10/28/2010 13:10'! name ^ 'Avoid "as to whether"'! ! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:42'! rationale ^ '"as to whether" is commonly misued, it is enough to write "whether".'! ! TLPatternRule subclass: #TLAvoidMultipleWordsUsageRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAvoidMultipleWordsUsageRule methodsFor: 'running' stamp: 'JorgeRessia 11/1/2010 15:00'! matchingPattern ^ self wordIn: self wordsToAvoid! ! !TLAvoidMultipleWordsUsageRule methodsFor: 'running' stamp: 'JorgeRessia 11/1/2010 14:54'! wordsToAvoid ^ self subclassResponsibility! ! TLAvoidMultipleWordsUsageRule subclass: #TLQualifiersRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLQualifiersRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid qualifier'! ! !TLQualifiersRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:43'! rationale ^ 'Qualifiers are the leeches that infest the pond of prose, sucking the blood of words.'! ! !TLQualifiersRule methodsFor: 'accessing' stamp: 'lr 11/2/2010 07:42'! wordsToAvoid ^ #('clearly' 'completely' 'exceedingly' 'excellent' 'extremely' 'fairly' 'few' 'huge' 'interestingly' 'largely' 'little' 'many' 'mostly' 'pretty' 'quite' 'rather' 'really' 'relatively' 'remarkably' 'several' 'significantly' 'substantially' 'surprisingly' 'tiny' 'various' 'vast' 'very')! ! TLAvoidMultipleWordsUsageRule subclass: #TLStuffRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLStuffRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:59'! name ^ 'Avoid "stuff"'! ! !TLStuffRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:43'! rationale ^ 'Avoid using the word "stuff". Is too general and weakens the sentence.'! ! !TLStuffRule methodsFor: 'running' stamp: 'JorgeRessia 11/1/2010 15:03'! wordsToAvoid ^ #('stuff' 'stuffs') ! ! TLAvoidMultipleWordsUsageRule subclass: #TLThingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLThingRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:00'! name ^ 'Avoid "thing"'! ! !TLThingRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:43'! rationale ^ 'Avoid using the word "thing". Is too general and weakens the sentence.'! ! !TLThingRule methodsFor: 'running' stamp: 'JorgeRessia 11/1/2010 15:21'! wordsToAvoid ^ #('thing' 'things') ! ! TLPatternRule subclass: #TLCannotRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCannotRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:39'! matchingString ^ 'can not'! ! !TLCannotRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:53'! name ^'Avoid "can not"'! ! !TLCannotRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:32'! rationale ^ '"Can not" as a two word phrase is used for stressing an impossibility, otherwise "cannot" should be used.'! ! TLPatternRule subclass: #TLCaseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCaseRule methodsFor: 'accessing' stamp: 'lr 11/30/2010 19:29'! matchingPattern ^ (self wordIn: #('case' 'cases')) , (self separators) , (self punctuation: '-') optional , (self separators) , (self wordIn: #('grammar' 'grammars' 'harden' 'histories' 'history' 'knife' 'knives' 'law' 'mod' 'sensitive' 'shot' 'stated' 'studies' 'study' 'system')) not! ! !TLCaseRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid "case"'! ! !TLCaseRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:43'! rationale ^ 'Often unnecessarey, e.g. "In many cases, the room lacked air conditioning" can be replaced with "Many of the rooms lacked air conditioning".'! ! TLPatternRule subclass: #TLCertainlyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCertainlyRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:44'! matchingString ^ 'certainly' ! ! !TLCertainlyRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid "certainly"'! ! !TLCertainlyRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:43'! rationale ^ 'Is a manerism that is used indicriminately by some speakers and writers. Avoid its usage if possible.'! ! TLPatternRule subclass: #TLClichesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLClichesRule methodsFor: 'accessing' stamp: 'lr 5/4/2011 19:49'! matchingPattern ^ (TLPatternTokenizer parse: 'all things being equal') / (TLPatternTokenizer parse: 'all things considered') / (TLPatternTokenizer parse: 'as a matter of fact') / (TLPatternTokenizer parse: 'as far as I am concerned') / (TLPatternTokenizer parse: 'at the end of the day') / (TLPatternTokenizer parse: 'at the present time') / (TLPatternTokenizer parse: 'due to the fact that') / (TLPatternTokenizer parse: 'for all intents and purposes') / (TLPatternTokenizer parse: 'for the most part') / (TLPatternTokenizer parse: 'for the purpose of') / (TLPatternTokenizer parse: 'in a manner of speaking') / (TLPatternTokenizer parse: 'in my opinion') / (TLPatternTokenizer parse: 'in the event of') / (TLPatternTokenizer parse: 'in the final analysis') / (TLPatternTokenizer parse: 'it seems that') / (TLPatternTokenizer parse: 'the point that I am trying to make') / (TLPatternTokenizer parse: 'type of') / (TLPatternTokenizer parse: 'what I am trying to say') / (TLPatternTokenizer parse: 'what I want to make clear')! ! !TLClichesRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 11:29'! name ^ 'Avoid cliches'! ! !TLClichesRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 11:30'! rationale ^ 'Avoid empty phrases (clichés). These phrases mean little. Just cut them off your writing.'! ! TLPatternRule subclass: #TLContinuousWordRepetitionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLContinuousWordRepetitionRule methodsFor: 'running' stamp: 'lr 11/2/2010 07:40'! matchingPattern | aWord | ^ (self wordSatisfying: [ :value | aWord := value. value isAllDigits not ]) , (self wordSatisfying: [ :value | aWord sameAs: value]) ! ! !TLContinuousWordRepetitionRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid continuous word repetition'! ! !TLContinuousWordRepetitionRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:46'! rationale ^ 'Continous word repetition is mostly a sign of copy-and-paste text.'! ! TLPatternRule subclass: #TLCouldRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCouldRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:45'! matchingString ^ 'could' ! ! !TLCouldRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid "could"'! ! !TLCouldRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:44'! rationale ^ 'Avoid using the word "could" because it weakens the sentence.'! ! TLPatternRule subclass: #TLCurrentlyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCurrentlyRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:45'! matchingString ^ 'currently' ! ! !TLCurrentlyRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid "currently"'! ! !TLCurrentlyRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:44'! rationale ^ 'In the sense of now with a verb in the present tense, "currently" is usually redundant. Emphasis is better achieved through a more precise reference to time.'! ! TLPatternRule subclass: #TLDifferentThanRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLDifferentThanRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:40'! matchingString ^ 'different than'! ! !TLDifferentThanRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:57'! name ^ 'Avoid "different than"'! ! !TLDifferentThanRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:46'! rationale ^ 'Here logic supports stablished usage: one thing differs from another, hence, different from.'! ! TLPatternRule subclass: #TLDoubtButRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLDoubtButRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:40'! matchingString ^ 'doubt but'! ! !TLDoubtButRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:57'! name ^ 'Avoid "doubt but"'! ! !TLDoubtButRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:46'! rationale ^ '"But" is unnecessary after "doubt".'! ! TLPatternRule subclass: #TLEachAndEveryOneRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLEachAndEveryOneRule methodsFor: 'running' stamp: 'lr 11/4/2010 10:40'! matchingString ^ 'each and every one'! ! !TLEachAndEveryOneRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:58'! name ^ 'Avoid "each and every one"'! ! !TLEachAndEveryOneRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:46'! rationale ^ 'Jargon, avoid except in dialog.'! ! TLPatternRule subclass: #TLEnormityRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLEnormityRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:45'! matchingString ^ 'enormity' ! ! !TLEnormityRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:02'! name ^ 'Avoid "enormity"'! ! !TLEnormityRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:44'! rationale ^ 'Use only in the sense of monstrous wickedness. Misleading, if not wrong, when used to express bigness.'! ! TLPatternRule subclass: #TLExcessOfAdjectivesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLExcessOfAdjectivesRule methodsFor: 'accessing' stamp: 'lr 5/4/2011 20:44'! matchingString ^ '{adjective} {adjective}' ! ! !TLExcessOfAdjectivesRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/30/2011 20:24'! name ^ 'Avoid excess of adjectives'! ! !TLExcessOfAdjectivesRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/30/2011 20:25'! rationale ^ 'Avoid using two or more continuous adjectives, be concise and clear.'! ! TLPatternRule subclass: #TLFactorRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLFactorRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:45'! matchingString ^ 'factor' ! ! !TLFactorRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:07'! name ^ 'Avoid "factor"'! ! !TLFactorRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:44'! rationale ^ 'A hackneyed word. The expression can be rephased without it.'! ! TLPatternRule subclass: #TLFunnyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLFunnyRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:45'! matchingString ^ 'funny'! ! !TLFunnyRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:08'! name ^ 'Avoid "funny"'! ! !TLFunnyRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:44'! rationale ^ 'Avoid it as a means of introduction. Do not announce that something is funny, it should be by itself.'! ! TLPatternRule subclass: #TLHelpButRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHelpButRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:40'! matchingString ^ 'help but'! ! !TLHelpButRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:58'! name ^ 'Avoid "help but"'! ! !TLHelpButRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:47'! rationale ^ '"But" is unnecessary after "help".'! ! TLPatternRule subclass: #TLHelpToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHelpToRule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:07'! matchingPattern ^ (self word: 'help') / (self word: 'helps') , (self separators) , (self word: 'to')! ! !TLHelpToRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:53'! name ^'Avoid "help to"'! ! !TLHelpToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/4/2010 10:41'! rationale ^ 'Never use the expressions "help/s to". This expression requires a direct object.'! ! TLPatternRule subclass: #TLHoweverRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHoweverRule methodsFor: 'accessing' stamp: 'lr 11/2/2010 12:27'! matchingPattern ^ (self anchorBegin) , (self word: 'however')! ! !TLHoweverRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:47'! name ^ 'Avoid "however"'! ! !TLHoweverRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:47'! rationale ^ 'Avoid starting a sentence with "however" when the meaning is nevertheless.'! ! TLPatternRule subclass: #TLImportantlyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLImportantlyRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:46'! matchingString ^ 'importantly' ! ! !TLImportantlyRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:08'! name ^ 'Avoid "importantly"'! ! !TLImportantlyRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:44'! rationale ^ 'Avoid by rephrasing.'! ! TLPatternRule subclass: #TLInOrderToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInOrderToRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:41'! matchingString ^ 'in order to'! ! !TLInOrderToRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:55'! name ^ 'Avoid "in order to"'! ! !TLInOrderToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/13/2010 19:55'! rationale ^ 'This expression is pure clutter and most of the time can be avoided.'! ! TLPatternRule subclass: #TLInRegardsToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInRegardsToRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:41'! matchingString ^ 'in regards to'! ! !TLInRegardsToRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:59'! name ^ 'Avoid "in regards to"'! ! !TLInRegardsToRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:47'! rationale ^ 'Often wrongly written "in regards to", should be "in regard to".'! ! TLPatternRule subclass: #TLInTermsOfRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInTermsOfRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:41'! matchingString ^ 'in terms of'! ! !TLInTermsOfRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:59'! name ^ 'Avoid "in terms of"'! ! !TLInTermsOfRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:47'! rationale ^ 'A piece of padding usually best omitted.'! ! TLPatternRule subclass: #TLInsightfulRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInsightfulRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:46'! matchingString ^ 'insightful' ! ! !TLInsightfulRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:08'! name ^ 'Avoid "insightful"'! ! !TLInsightfulRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:44'! rationale ^ 'The word is a suspicious overstatement for perceptive. Only used for remarkable visions.'! ! TLPatternRule subclass: #TLInterestingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInterestingRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:46'! matchingString ^ 'interesting' ! ! !TLInterestingRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid "interesting"'! ! !TLInterestingRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:45'! rationale ^ 'Avoid it as a means of introduction. Do not announce that something is interesting.'! ! TLPatternRule subclass: #TLIrregardlessRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLIrregardlessRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:46'! matchingString ^ 'irregardless' ! ! !TLIrregardlessRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid "irregardless"'! ! !TLIrregardlessRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:45'! rationale ^ 'Should be "regardless". Irregardless is avoided by careful users of English.'! ! TLPatternRule subclass: #TLLetsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLLetsRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/26/2011 13:45'! matchingString ^ 'lets'! ! !TLLetsRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/26/2011 13:43'! name ^ 'Avoid lets'! ! !TLLetsRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/26/2011 13:44'! rationale ^ 'Let plus a subject should be used instead of using lets.'! ! TLPatternRule subclass: #TLNegativeFormRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNegativeFormRule methodsFor: 'accessing' stamp: 'lr 5/4/2011 19:53'! longRationale ^ 'Make definite assertions. Avoid tame, colorless, hesitating, non-committal language.'! ! !TLNegativeFormRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 10:25'! matchingString ^ 'not' ! ! !TLNegativeFormRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 10:29'! name ^ 'Avoid negative form'! ! !TLNegativeFormRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 10:29'! rationale ^ 'When possible, put statements in positive form.'! ! TLPatternRule subclass: #TLNoCommaBeforeThatRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoCommaBeforeThatRule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:11'! matchingPattern ^ (self word) , (self separators) , (self punctuation: ',') , (self separators) , (self word: 'that')! ! !TLNoCommaBeforeThatRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:55'! name ^ 'Avoid comma'! ! !TLNoCommaBeforeThatRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:47'! rationale ^ 'In German, you must put a comma before "dass". Not in English.'! ! TLPatternRule subclass: #TLNoContinuousPunctuationMarksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoContinuousPunctuationMarksRule methodsFor: 'running' stamp: 'lr 11/4/2010 10:41'! matchingPattern ^ (self punctuationIn: self punctuationsToAvoid) , (self punctuationIn: self punctuationsToAvoid)! ! !TLNoContinuousPunctuationMarksRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:00'! name ^ 'Avoid continuous punctuation'! ! !TLNoContinuousPunctuationMarksRule methodsFor: 'running' stamp: 'JorgeRessia 11/2/2010 08:56'! punctuationsToAvoid ^ #(',' '.' ':' ';' '!!' '?') ! ! !TLNoContinuousPunctuationMarksRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:47'! rationale ^ 'There should be no continuous punctuation marks.'! ! TLPatternRule subclass: #TLNoContractionsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoContractionsRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/26/2011 13:32'! matchingPattern ^ (self word) , (self punctuation: '''') , (self wordIn: #('ve' 't' 'd' 'll' 're' 'm' 's'))! ! !TLNoContractionsRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:55'! name ^ 'Avoid contraction'! ! !TLNoContractionsRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:48'! rationale ^ 'Contractions are not allowed since they could be ambiguous.'! ! TLPatternRule subclass: #TLNoSpacesBeforePunctuationMarkRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'running' stamp: 'lr 11/3/2010 14:46'! matchingPattern ^ (self whitespace) , (self punctuationIn: self punctuationsToAvoid) ! ! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid whitespace'! ! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'running' stamp: 'JorgeRessia 11/2/2010 08:58'! punctuationsToAvoid ^ #(',' '.' ':' ';' '!!' '?') ! ! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:48'! rationale ^ 'There should be no whitespaces before any punctuation mark.'! ! TLPatternRule subclass: #TLOftenEnoughRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLOftenEnoughRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:42'! matchingString ^ 'often enough'! ! !TLOftenEnoughRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/2/2010 15:58'! name ^ 'Avoid "offen enough"'! ! !TLOftenEnoughRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:48'! rationale ^ 'Avoid using "often enough" it is pure clutter. Use "often" instead.'! ! TLPatternRule subclass: #TLOneOfTheMostRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLOneOfTheMostRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:42'! matchingString ^ 'one of the most'! ! !TLOneOfTheMostRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:55'! name ^ 'Avoid "one of the most"'! ! !TLOneOfTheMostRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:48'! rationale ^ 'Avoid this feeble formula. There is nothing wrong with the grammar the formula is simple threadbare.'! ! TLPatternRule subclass: #TLPassiveVoiceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLPassiveVoiceRule methodsFor: 'private' stamp: 'lr 11/2/2010 12:46'! irregularWords ^ #('awoken' 'been' 'born' 'beat' 'become' 'begun' 'bent' 'beset' 'bet' 'bid' 'bidden' 'bound' 'bitten' 'bled' 'blown' 'broken' 'bred' 'brought' 'broadcast' 'built' 'burnt' 'burst' 'bought' 'cast' 'caught' 'chosen' 'clung' 'come' 'cost' 'crept' 'cut' 'dealt' 'dug' 'dived' 'done' 'drawn' 'dreamt' 'driven' 'drunk' 'eaten' 'fallen' 'fed' 'felt' 'fought' 'found' 'fit' 'fled' 'flung' 'flown' 'forbidden' 'forgotten' 'foregone' 'forgiven' 'forsaken' 'frozen' 'gotten' 'given' 'gone' 'ground' 'grown' 'hung' 'heard' 'hidden' 'hit' 'held' 'hurt' 'kept' 'knelt' 'knit' 'known' 'laid' 'led' 'leapt' 'learnt' 'left' 'lent' 'let' 'lain' 'lighted' 'lost' 'made' 'meant' 'met' 'misspelt' 'mistaken' 'mown' 'overcome' 'overdone' 'overtaken' 'overthrown' 'paid' 'pled' 'proven' 'put' 'quit' 'read' 'rid' 'ridden' 'rung' 'risen' 'run' 'sawn' 'said' 'seen' 'sought' 'sold' 'sent' 'set' 'sewn' 'shaken' 'shaven' 'shorn' 'shed' 'shone' 'shod' 'shot' 'shown' 'shrunk' 'shut' 'sung' 'sunk' 'sat' 'slept' 'slain' 'slid' 'slung' 'slit' 'smitten' 'sown' 'spoken' 'sped' 'spent' 'spilt' 'spun' 'spit' 'split' 'spread' 'sprung' 'stood' 'stolen' 'stuck' 'stung' 'stunk' 'stridden' 'struck' 'strung' 'striven' 'sworn' 'swept' 'swollen' 'swum' 'swung' 'taken' 'taught' 'torn' 'told' 'thought' 'thrived' 'thrown' 'thrust' 'trodden' 'understood' 'upheld' 'upset' 'woken' 'worn' 'woven' 'wed' 'wept' 'wound' 'won' 'withheld' 'withstood' 'wrung' 'written')! ! !TLPassiveVoiceRule methodsFor: 'accessing' stamp: 'lr 11/2/2010 12:47'! matchingPattern "http://matt.might.net/articles/shell-scripts-for-passive-voice-weasel-words-duplicates/" ^ (self wordIn: self verbWords) , (self separators) , ((self wordSatisfying: [ :value | value endsWith: 'ed' ]) / (self wordIn: self irregularWords))! ! !TLPassiveVoiceRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid passive voice'! ! !TLPassiveVoiceRule methodsFor: 'accessing' stamp: 'lr 9/5/2010 21:58'! rationale ^ 'Passive voice often hides relevant or explanatory information.'! ! !TLPassiveVoiceRule methodsFor: 'private' stamp: 'lr 11/2/2010 12:45'! verbWords ^ #('am' 'are' 'were' 'being' 'is' 'been' 'was' 'be')! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 11/2/2010 12:24'! anchorBegin ^ [ :stream | stream position = 0 ifFalse: [ PPFailure message: 'begin of input expected' at: stream position ] ] asParser! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 11/3/2010 14:45'! markup ^ PPPredicateObjectParser on: [ :element | element isMarkup ] message: 'markup expected'! ! !TLPatternRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:38'! matchingPattern "Override in subclasses to answer a custom pattern parser." ^ TLPatternTokenizer parse: self matchingString! ! !TLPatternRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:37'! matchingString "Override in subclasses to answer a string pattern." self error: 'Override #matchingPattern or #matchingString in subclasses to provide pattern.'! ! !TLPatternRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 12:30'! pattern "Answer the lazily initialized pattern. Do not override in subclasses." ^ pattern ifNil: [ pattern := self matchingPattern flatten ]! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 10/31/2010 14:19'! punctuation ^ PPPredicateObjectParser on: [ :element | element isPunctuation ] message: 'punctuation expected'! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 10/31/2010 14:19'! punctuation: aString ^ PPPredicateObjectParser on: [ :element | element isPunctuation and: [ element text = aString ] ] message: 'punctuation expected'! ! !TLPatternRule methodsFor: 'factory' stamp: 'JorgeRessia 11/1/2010 10:23'! punctuationIn: aCollection ^ PPPredicateObjectParser on: [ :element | element isPunctuation and: [ aCollection anySatisfy: [ :each | element text sameAs: each ] ] ] message: 'punctuation expected'! ! !TLPatternRule methodsFor: 'factory' stamp: 'JorgeRessia 11/1/2010 10:17'! punctuationSatisfying: aBlock ^ PPPredicateObjectParser on: [ :element | element isPunctuation and: [ aBlock value: element text ] ] message: 'punctuation expected'! ! !TLPatternRule methodsFor: 'running' stamp: 'JorgeRessia 11/1/2010 11:23'! runOnSentence: aSentence ^ (self pattern matchesIn: aSentence children) collect: [ :each | TLRuleFailure on: self at: (TLPhrase withAll: each) ]! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 11/3/2010 14:45'! separator ^ self whitespace / self markup! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 10/31/2010 13:58'! separators ^ self separator star! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 11/3/2010 14:45'! whitespace ^ PPPredicateObjectParser on: [ :element | element isWhitespace ] message: 'whitespace expected'! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 10/31/2010 14:19'! word ^ PPPredicateObjectParser on: [ :element | element isWord ] message: 'word expected'! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 10/31/2010 14:20'! word: aString ^ PPPredicateObjectParser on: [ :element | element isWord and: [ element text sameAs: aString ] ] message: 'word expected'! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 10/31/2010 14:20'! wordIn: aCollection ^ PPPredicateObjectParser on: [ :element | element isWord and: [ aCollection anySatisfy: [ :each | element text sameAs: each ] ] ] message: 'word expected'! ! !TLPatternRule methodsFor: 'factory' stamp: 'lr 10/31/2010 14:45'! wordSatisfying: aBlock ^ PPPredicateObjectParser on: [ :element | element isWord and: [ aBlock value: element text ] ] message: 'word expected'! ! TLPatternRule subclass: #TLRegardedAsBeingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLRegardedAsBeingRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:42'! matchingString ^ 'regarded as being'! ! !TLRegardedAsBeingRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:55'! name ^ 'Avoid "regarded as"'! ! !TLRegardedAsBeingRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:48'! rationale ^ '"Being" is not appropriate after "regard as".'! ! TLPatternRule subclass: #TLRequireToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLRequireToRule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:21'! matchingPattern ^ (self word: 'require') / (self word: 'requires') , (self separators) , (self word: 'to')! ! !TLRequireToRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:56'! name ^ 'Avoid "required to"'! ! !TLRequireToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/4/2010 10:25'! rationale ^ 'Never use the expressions "require/s to". This expression requires a direct object.'! ! TLPatternRule subclass: #TLSoCalledRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSoCalledRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:42'! matchingString ^ 'so called'! ! !TLSoCalledRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/2/2010 15:53'! name ^ 'Avoid "so called"'! ! !TLSoCalledRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/2/2010 15:53'! rationale ^ 'Avoid using "so called" it is a general expression that adds nothing to the sentence.'! ! TLPatternRule subclass: #TLSoOnRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSoOnRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:43'! matchingString ^ 'so on'! ! !TLSoOnRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/2/2010 15:47'! name ^ 'Avoid "so on"'! ! !TLSoOnRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/2/2010 15:48'! rationale ^ 'Avoid using "so on" it is a general expression that adds nothing to the sentence.'! ! TLPatternRule subclass: #TLSomehowRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSomehowRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:46'! matchingString ^ 'somehow' ! ! !TLSomehowRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:59'! name ^ 'Avoid "somehow"'! ! !TLSomehowRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:45'! rationale ^ 'Avoid using the word "somehow". Is too general and weakens the sentence.'! ! TLPatternRule subclass: #TLTheFactIsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheFactIsRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:43'! matchingString ^ 'the fact is'! ! !TLTheFactIsRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:56'! name ^ 'Avoid "the fact is"'! ! !TLTheFactIsRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:49'! rationale ^ 'A bad beginning for a sentence. If you think you are possessed of the truth or fact state it.'! ! TLPatternRule subclass: #TLTheFactThatRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheFactThatRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:43'! matchingString ^ 'the fact that'! ! !TLTheFactThatRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:56'! name ^ 'Avoid "the fact that"'! ! !TLTheFactThatRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:49'! rationale ^ '"The fact that" is an especially debilitating expression.'! ! TLPatternRule subclass: #TLTheTruthIsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheTruthIsRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:43'! matchingString ^ 'the truth is'! ! !TLTheTruthIsRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:56'! name ^ 'Avoid "the truth is"'! ! !TLTheTruthIsRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:49'! rationale ^ 'A bad beginning for a sentence. If you think you are possessed of the truth or fact state it.'! ! TLPatternRule subclass: #TLThereIsAreOpenerRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLThereIsAreOpenerRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 11:09'! matchingPattern ^ (self anchorBegin) , (self word: 'there') , (self separators) , ( (self word: 'is') / (self word: 'are') )! ! !TLThereIsAreOpenerRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 10:59'! name ^'Avoid "There is/are" openers'! ! !TLThereIsAreOpenerRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/4/2011 11:16'! rationale ^ 'Avoid the use of There is/are as openers. There are two security guards at the gate -> Two security guards stand at the gate.'! ! TLPatternRule subclass: #TLThusRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLThusRule methodsFor: 'accessing' stamp: 'lr 11/2/2010 12:25'! matchingPattern ^ (self anchorBegin) , (self word: 'thus')! ! !TLThusRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid "thus"'! ! !TLThusRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:35'! rationale ^ 'Avoid starting a sentence with "thus". This word should be used for implication between two statements.'! ! TLPatternRule subclass: #TLTrueFactRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTrueFactRule methodsFor: 'accessing' stamp: 'lr 10/31/2010 14:24'! matchingPattern ^ (self word: 'true') , (self separators) , ((self word: 'fact') / (self word: 'facts'))! ! !TLTrueFactRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:57'! name ^ 'Avoid "true fact"'! ! !TLTrueFactRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 14:20'! rationale ^ 'Never use the expressions "true fact/s". It is a tautology.'! ! TLPatternRule subclass: #TLWouldRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLWouldRule methodsFor: 'accessing' stamp: 'lr 11/4/2010 10:46'! matchingString ^ 'would' ! ! !TLWouldRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid "would"'! ! !TLWouldRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:36'! rationale ^ 'Avoid using the word "would" because it weakens the sentence.'! ! !TLTextLintRule class methodsFor: 'accessing' stamp: 'lr 10/25/2010 19:38'! allRules ^ self subclasses isEmpty ifTrue: [ Array with: self new ] ifFalse: [ self subclasses gather: [ :each | each allRules ] ]! ! !TLTextLintRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:44'! name ^ self subclassResponsibility ! ! !TLTextLintRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 17:44'! rationale ^ self subclassResponsibility! ! !TLTextLintRule methodsFor: 'running' stamp: 'lr 11/2/2010 07:43'! runOn: aDocument ^ OrderedCollection new addAll: (self runOnDocument: aDocument); addAll: (self runOnParagraphsIn: aDocument); addAll: (self runOnSentencesIn: aDocument); addAll: (self runOnWordsIn: aDocument); yourself! ! !TLTextLintRule methodsFor: 'running' stamp: 'lr 11/2/2010 07:43'! runOnDocument: aDocument ^ #()! ! !TLTextLintRule methodsFor: 'running' stamp: 'lr 11/2/2010 07:43'! runOnParagraph: aParagraph ^ #()! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 18:29'! runOnParagraphsIn: aDocument ^ aDocument paragraphs gather: [ :each | self runOnParagraph: each ]! ! !TLTextLintRule methodsFor: 'running' stamp: 'lr 11/2/2010 07:42'! runOnSentence: aSentence ^ #()! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 18:30'! runOnSentencesIn: aDocument ^ aDocument sentences gather: [ :each | self runOnSentence: each ]! ! !TLTextLintRule methodsFor: 'running' stamp: 'lr 11/2/2010 07:42'! runOnWord: aWord ^ #()! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 18:28'! runOnWordsIn: aDocument ^ aDocument words gather: [ :each | self runOnWord: each ]! ! TLTextLintRule subclass: #TLWordRepetitionInParagraphRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLWordRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:00'! name ^ 'Avoid word repetition'! ! !TLWordRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'lr 11/3/2010 19:49'! rationale ^ 'The constant repetition of the same words in a paragraph is weakening.'! ! !TLWordRepetitionInParagraphRule methodsFor: 'running' stamp: 'lr 5/4/2011 20:06'! runOnParagraph: aParagraph | counts results | counts := Bag new. aParagraph words do: [ :word | counts add: word text ]. results := OrderedCollection new. aParagraph words do: [ :word | self wordRepetitionLimit < (counts occurrencesOf: word text) ifTrue: [ results add: word ] ]. ^ results! ! !TLWordRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 10:53'! wordRepetitionLimit ^2! ! Object subclass: #TLWordClassifier instanceVariableNames: '' classVariableNames: 'ClassificationTable' poolDictionaries: '' category: 'TextLint-Model'! !TLWordClassifier class methodsFor: 'accessing' stamp: 'lr 5/4/2011 20:34'! classify: aString ^ ClassificationTable at: aString asLowercase ifAbsent: [ #() ]! ! !TLWordClassifier class methodsFor: 'private' stamp: 'lr 5/4/2011 20:31'! database ^ #('a' #article 'a' #pronoun 'aardvark' #noun 'aardvark' #adverb 'aback' #verb 'aback' #adverb 'aback' #adjective 'abacterial' #adjective 'abacus' #noun 'abacuses' #noun 'abaft' #adverb 'abalone' #noun 'abalones' #noun 'abandon' #noun 'abandon' #verb 'abandoned' #adjective 'abandonee' #adjective 'abandoner' #adjective 'abandoning' #verb 'abandonment' #noun 'abandonments' #noun 'abandons' #verb 'abase' #verb 'abasement' #noun 'abasements' #noun 'abases' #verb 'abash' #verb 'abashed' #adjective 'abasing' #adjective 'abate' #verb 'abated' #verb 'abatement' #noun 'abates' #verb 'abating' #adjective 'abattoir' #noun 'abbe' #noun 'abberations' #noun 'abbey' #noun 'abbeys' #noun 'abbot' #noun 'abbots' #noun 'abbreviate' #verb 'abbreviated' #verb 'abbreviates' #verb 'abbreviating' #verb 'abbreviation' #noun 'abbreviations' #noun 'abbreviator' #noun 'abdicable' #adjective 'abdicate' #verb 'abdicated' #adjective 'abdication' #verb 'abdicator' #adjective 'abdomen' #noun 'abdomens' #noun 'abdominal' #adjective 'abdominally' #adverb 'abduct' #verb 'abducted' #verb 'abducting' #verb 'abduction' #noun 'abductions' #noun 'abductor' #adjective 'abductors' #adjective 'abducts' #verb 'abeam' #adverb 'abecedarian' #noun 'abed' #noun 'aberrance' #noun 'aberrant' #adjective 'aberrantly' #adverb 'aberration' #noun 'abet' #verb 'abetment' #noun 'abetted' #verb 'abetter' #noun 'abetting' #adjective 'abettor' #noun 'abeyance' #noun 'abeyant' #adjective 'abhor' #verb 'abhorred' #verb 'abhorrence' #noun 'abhorrently' #adverb 'abhorring' #adjective 'abhors' #verb 'abide' #verb 'abided' #adjective 'abides' #verb 'abiding' #adjective 'abilities' #noun 'ability' #noun 'abiotic' #adjective 'abject' #adjective 'abjection' #noun 'abjectly' #adjective 'abjuration' #noun 'abjure' #verb 'ablative' #adjective 'ablaze' #adjective 'able' #adjective 'able' #verb 'abler' #adjective 'ablest' #adjective 'ablution' #noun 'ablutions' #noun 'ably' #adjective 'abnegate' #verb 'abnegates' #verb 'abnegation' #noun 'abnormal' #adjective 'abnormalities' #noun 'abnormality' #noun 'abnormally' #adverb 'abode' #noun 'abodes' #noun 'aboil' #verb 'abolish' #verb 'abolished' #verb 'abolisher' #adjective 'abolishment' #noun 'abolition' #noun 'abolitionism' #noun 'abolitionist' #adjective 'abolitionists' #noun 'abominable' #adjective 'abominably' #adverb 'abominate' #verb 'abomination' #noun 'abominations' #noun 'aboriginal' #noun 'aboriginally' #adverb 'aborigine' #noun 'aborigines' #noun 'abort' #verb 'aborted' #verb 'aborter' #noun 'aborting' #adjective 'abortion' #noun 'abortionist' #noun 'abortions' #noun 'abortive' #adjective 'abortively' #verb 'aborts' #verb 'abounding' #adjective 'about' #adjective 'above' #adjective 'aboveboard' #adjective 'aboveground' #adjective 'abovementioned' #adjective 'abracadabra' #verb 'abradable' #adjective 'abrade' #verb 'abrasion' #noun 'abrasions' #noun 'abrasive' #adjective 'abrasives' #noun 'abreast' #adjective 'abridge' #verb 'abridged' #verb 'abridgement' #noun 'abridging' #adjective 'abroad' #adverb 'abrogate' #verb 'abrogated' #verb 'abrogation' #noun 'abrupt' #adjective 'abruptly' #adjective 'abruptness' #noun 'abscess' #noun 'abscesses' #noun 'abscond' #verb 'absconded' #verb 'absence' #noun 'absences' #noun 'absent' #adjective 'absentee' #noun 'absenteeism' #noun 'absentees' #noun 'absently' #adverb 'absentminded' #adjective 'absentmindedly' #adverb 'absentmindedness' #noun 'absinth' #noun 'absinthe' #noun 'absolute' #adjective 'absolutely' #adverb 'absolution' #noun 'absolutism' #noun 'absolve' #verb 'absolved' #adjective 'absolving' #adjective 'absorb' #verb 'absorbability' #adjective 'absorbable' #adjective 'absorbant' #adjective 'absorbed' #adjective 'absorbent' #adjective 'absorbing' #adjective 'absorption' #noun 'abstain' #verb 'abstained' #adjective 'abstemious' #adjective 'abstention' #noun 'abstentions' #noun 'abstinence' #noun 'abstinent' #adjective 'abstinently' #adverb 'abstract' #adjective 'abstract' #noun 'abstraction' #noun 'abstruse' #adjective 'absurd' #adjective 'absurdism' #noun 'absurdist' #noun 'absurdities' #noun 'absurdity' #noun 'abundance' #noun 'abundant' #adjective 'abundantly' #adjective 'abuse' #noun 'abused' #verb 'abusive' #adjective 'abusively' #adverb 'abut' #verb 'abuzz' #adjective 'abysmal' #noun 'abysmally' #adverb 'abyss' #noun 'abysses' #noun 'acacia' #noun 'academic' #adjective 'academical' #adjective 'academically' #adverb 'academician' #noun 'academies' #noun 'academism' #noun 'academy' #noun 'acanthus' #noun 'acanthuses' #noun 'accede' #verb 'accelerate' #verb 'accelerated' #adjective 'acceleration' #noun 'accelerations' #noun 'accelerator' #noun 'accelerators' #noun 'accelerometer' #noun 'accelerometers' #noun 'accent' #noun 'accented' #verb 'accents' #noun 'accentual' #adjective 'accentually' #adverb 'accentuate' #verb 'accentuated' #adjective 'accentuation' #noun 'accept' #verb 'acceptability' #noun 'acceptable' #adjective 'acceptably' #adverb 'acceptance' #noun 'accepted' #verb 'accepter' #noun 'acceptor' #noun 'access' #noun 'accessed' #verb 'accessibility' #noun 'accessible' #adjective 'accession' #noun 'accessorial' #adjective 'accessories' #noun 'accessorize' #verb 'accessors' #noun 'accessory' #noun 'accident' #noun 'accidental' #adjective 'accidentalism' #noun 'accidentalist' #noun 'accidentally' #adverb 'accidently' #adverb 'accidents' #noun 'acclaim' #verb 'acclamation' #noun 'acclimate' #verb 'acclimated' #adjective 'acclimatize' #verb 'accolade' #noun 'accolades' #noun 'accommodate' #verb 'accommodated' #verb 'accommodating' #adjective 'accommodation' #noun 'accommodations' #noun 'accompanied' #adjective 'accompanier' #noun 'accompanies' #verb 'accompaniment' #noun 'accompaniments' #noun 'accompanist' #noun 'accompanists' #noun 'accompany' #verb 'accompanyist' #noun 'accompanyists' #noun 'accomplice' #noun 'accomplices' #noun 'accomplish' #verb 'accomplished' #adjective 'accomplishment' #noun 'accomplishments' #noun 'accord' #noun 'accorder' #noun 'accorders' #noun 'accordion' #noun 'accordionist' #noun 'accordionists' #noun 'accordions' #noun 'accords' #noun 'accost' #verb 'account' #noun 'accountability' #noun 'accountable' #adjective 'accountant' #noun 'accouterment' #noun 'accredited' #verb 'accrued' #verb 'accruement' #noun 'accumulated' #verb 'acetaminophen' #noun 'acetify' #verb 'acetone' #noun 'acid' #noun 'acidic' #adjective 'admission' #adverb 'allergen' #noun 'allergic' #adjective 'allergies' #noun 'allergy' #noun 'alleviate' #verb 'alleviated' #adjective 'alley' #noun 'alleys' #noun 'alliance' #noun 'alliances' #noun 'allied' #adjective 'alligator' #noun 'alligators' #noun 'alliteration' #noun 'alliterations' #noun 'allocate' #verb 'allocated' #adjective 'allocation' #noun 'allocations' #noun 'allocution' #noun 'allot' #verb 'allow' #verb 'allowable' #adjective 'allowance' #noun 'allowed' #adjective 'alloy' #noun 'alphabet' #noun 'alphabetic' #adjective 'alphabetical' #adjective 'alphabetically' #adverb 'alphabetization' #noun 'alphabetizations' #noun 'alphabetize' #verb 'alphabetized' #adjective 'alphabetizing' #verb 'alphabets' #noun 'alphamerical' #adjective 'alphanumeric' #noun 'alphanumerical' #adjective 'alphanumerically' #adverb 'alphanumerics' #adverb 'alpine' #adjective 'alpinism' #noun 'alpinist' #noun 'already' #conjunction 'also' #conjunction 'altercation' #noun 'altercations' #noun 'alternate' #verb 'alternated' #adjective 'alternately' #adverb 'among' #preposition 'amoral' #adjective 'amorous' #adjective 'amorously' #adverb 'amorphous' #adjective 'amount' #verb 'amount' #noun 'amp' #noun 'ampere' #noun 'ampersand' #noun 'amphetamine' #noun 'and' #preposition 'anyway' #adverb 'anywhere' #adverb 'aorta' #noun 'apace' #adverb 'apart' #adjective 'apartheid' #noun 'apartment' #noun 'apathetic' #adjective 'apathy' #noun 'ape' #noun 'ape' #verb 'aperitif' #noun 'aperture' #noun 'apex' #noun 'aphid' #noun 'arrive' #verb 'audit' #noun 'auditorium' #noun 'auditoriums' #noun 'audits' #verb 'babble' #verb 'babies' #noun 'baby' #noun 'baccalaureate' #noun 'baccarat' #noun 'bachelor' #noun 'bachelors' #noun 'bacilli' #noun 'bacillus' #noun 'backbone' #noun 'backside' #noun 'backslide' #verb 'backup' #noun 'backward' #preposition 'bag' #noun 'bah' #verb 'bairn' #noun 'bake' #verb 'bakeshop' #noun 'baldhead' #adjective 'baldly' #adverb 'baldness' #noun 'balk' #verb 'balls' #noun 'ballyhoo' #noun 'balm' #noun 'bamboo' #noun 'bamboozle' #verb 'bandleader' #noun 'bandmaster' #noun 'bane' #noun 'banished' #adjective 'barb' #noun 'barbarian' #noun 'barbarians' #noun 'barbarism' #noun 'barber' #noun 'barmaid' #noun 'barman' #noun 'barracks' #noun 'beach' #noun 'bear' #noun 'bear' #verb 'bed' #noun 'bedroom' #noun 'believe' #verb 'betray' #verb 'bibliographic' #adjective 'bibliographies' #noun 'bibliography' #noun 'blackberry' #noun 'boxer' #noun 'boy' #noun 'boys' #noun 'brain' #noun 'brood' #verb 'build' #verb 'building' #noun 'bye' #preposition 'cab' #noun 'cabal' #noun 'cabala' #noun 'cabalism' #noun 'cabalist' #noun 'cabalistic' #adjective 'caballero' #noun 'cabaret' #noun 'cabbage' #noun 'cabbages' #noun 'cabdriver' #noun 'cabin' #noun 'cabinet' #noun 'cabinetmaker' #noun 'cabinetmakers' #noun 'cabinets' #noun 'cabins' #noun 'cable' #noun 'cabled' #adjective 'cablegram' #noun 'cablegrams' #noun 'cables' #noun 'cabling' #noun 'cabman' #noun 'caboose' #noun 'cabotage' #noun 'cabriolet' #noun 'cabs' #noun 'cacao' #noun 'cacciatore' #noun 'cachalot' #noun 'cache' #noun 'cachepot' #noun 'caches' #noun 'cackle' #noun 'cackled' #verb 'cackles' #noun 'cackling' #verb 'cacophony' #noun 'cacti' #noun 'cactus' #noun 'cad' #noun 'cadaverous' #adjective 'caddies' #noun 'caddy' #noun 'cadence' #noun 'cadet' #noun 'cadetship' #noun 'cadge' #verb 'cadger' #noun 'cafe' #noun 'cafes' #noun 'cafeteria' #noun 'cafeterias' #noun 'caffeine' #verb 'caftan' #noun 'cage' #noun 'cages' #noun 'cahier' #noun 'cairn' #noun 'cairns' #noun 'caitiff' #adjective 'cajole' #verb 'cajoler' #noun 'cajolery' #noun 'cake' #noun 'calcium' #noun 'calculate' #verb 'calibrate' #verb 'calibrated' #adjective 'calibration' #noun 'car' #noun 'carbonization' #noun 'carbonize' #verb 'carbonized' #adjective 'carbonless' #adjective 'carburetor' #noun 'carburetors' #noun 'carburization' #noun 'carburize' #verb 'card' #noun 'cardamom' #noun 'cardiac' #adjective 'cardigan' #noun 'cardioid' #noun 'cardioids' #noun 'care' #noun 'cared' #adjective 'career' #noun 'careful' #adjective 'carefully' #adjective 'cat' #noun 'cell' #noun 'cellular' #adjective 'cherries' #noun 'church' #noun 'churches' #noun 'cloak' #noun 'cloaks' #noun 'clock' #noun 'clockmaker' #noun 'cloister' #noun 'clone' #noun 'coal' #noun 'computer' #noun 'computers' #noun 'comrades' #noun 'conjuring' #verb 'contemplate' #verb 'contemplates' #verb 'contemplation' #noun 'contemplations' #noun 'contemplative' #adjective 'contemporaneous' #adjective 'contemporaneously' #adverb 'contemporaries' #noun 'contemporaries' #adjective 'contemporary' #adjective 'contempt' #noun 'contemptible' #adjective 'contemptibly' #adverb 'contemptuous' #adjective 'contemptuously' #adverb 'contend' #verb 'contender' #noun 'contenders' #noun 'contending' #adjective 'contends' #verb 'content' #verb 'content' #adjective 'contented' #adjective 'contentedly' #adverb 'contentedness' #noun 'contention' #noun 'contentions' #noun 'contentious' #adjective 'contentment' #noun 'contents' #noun 'contest' #noun 'contest' #verb 'contestant' #noun 'cot' #noun 'coterie' #noun 'cotillion' #noun 'cotillon' #noun 'cottage' #noun 'cottager' #noun 'couch' #noun 'cough' #verb 'coughs' #noun 'count' #verb 'countenance' #noun 'counteract' #verb 'counterbalance' #noun 'counterfeit' #adjective 'countermand' #verb 'countermarch' #noun 'counterplot' #noun 'counterpoint' #noun 'counterpoise' #verb 'counterweight' #noun 'countess' #noun 'countless' #adjective 'country' #verb 'countryman' #noun 'county' #noun 'couple' #noun 'couplet' #noun 'coupon' #noun 'courage' #noun 'courageous' #adjective 'courageously' #adjective 'courier' #noun 'course' #noun 'courser' #noun 'court' #noun 'courteous' #adjective 'courteously' #adverb 'courteousness' #noun 'courthouse' #noun 'courtier' #noun 'courtliness' #adjective 'courtly' #adjective 'courtmartial' #noun 'courtroom' #noun 'courtship' #noun 'cousin' #noun 'cove' #noun 'covenant' #noun 'cover' #verb 'covert' #adjective 'covet' #adjective 'covetous' #adjective 'covetously' #adjective 'cow' #noun 'coward' #noun 'cowardly' #adjective 'cower' #verb 'cowherd' #noun 'cowl' #noun 'coxcomb' #noun 'coy' #adjective 'coyly' #adverb 'coyness' #noun 'coyote' #noun 'cozily' #adverb 'crab' #noun 'crabapple' #noun 'crabbed' #adjective 'crack' #noun 'cracker' #noun 'crackle' #verb 'cradle' #noun 'craft' #noun 'craftily' #adverb 'crag' #noun 'cram' #verb 'cramp' #noun 'cranberry' #noun 'crane' #noun 'cranium' #noun 'crank' #noun 'crankiness' #noun 'cranky' #adjective 'crape' #noun 'crash' #verb 'crate' #noun 'crater' #noun 'crave' #verb 'craven' #adjective 'crawl' #verb 'crayfish' #noun 'crayon' #noun 'craze' #noun 'crazily' #adverb 'crazy' #adjective 'creak' #verb 'cream' #noun 'creamy' #adjective 'crease' #verb 'create' #verb 'creator' #noun 'creature' #noun 'credence' #noun 'credential' #noun 'credit' #noun 'creditably' #adverb 'creditor' #noun 'credo' #verb 'credulity' #noun 'credulous' #adjective 'credulously' #adverb 'creed' #noun 'creek' #noun 'creep' #verb 'creeps' #noun 'cremate' #verb 'cut' #verb 'cute' #adjective 'cuteness' #noun 'cutoffs' #noun 'cutout' #noun 'cuts' #noun 'cutter' #noun 'cutting' #noun 'cyanate' #noun 'cyanide' #noun 'cybernetic' #adjective 'cybernetician' #noun 'cybernetics' #noun 'cycle' #noun 'cyclic' #adjective 'cyclical' #adjective 'cyclist' #noun 'cyclists' #noun 'cycloid' #noun 'cycloidal' #adjective 'cyclone' #noun 'cyclonic' #adjective 'cyclopean' #adjective 'cyclotron' #noun 'cylinder' #noun 'dad' #noun 'daddies' #noun 'daddy' #noun 'dads' #noun 'daffy' #adjective 'daft' #adjective 'dagger' #noun 'dahlia' #noun 'dahlias' #noun 'dalmatian' #adjective 'dalmatians' #noun 'dam' #noun 'damage' #verb 'damage' #noun 'damage' #verb 'damaged' #adjective 'damages' #noun 'damnation' #noun 'damned' #adjective 'damp' #adjective 'dampen' #verb 'dampness' #noun 'dams' #noun 'dancing' #verb 'dandies' #noun 'dandruff' #noun 'danger' #noun 'dangerous' #adjective 'day' #noun 'daybreak' #noun 'daylight' #noun 'days' #noun 'deactivate' #verb 'deactivation' #noun 'dead' #adjective 'deaf' #adjective 'deep' #adjective 'density' #noun 'deserve' #verb 'device' #noun 'dictated' #verb 'dictates' #verb 'dictation' #noun 'dictations' #noun 'dictionaries' #noun 'dictionary' #noun 'did' #verb 'die' #verb 'died' #verb 'diesel' #noun 'diet' #noun 'dietetically' #adverb 'diets' #noun 'different' #adjective 'difficulties' #noun 'difficulty' #noun 'dig' #verb 'digested' #verb 'dignitaries' #noun 'dignities' #noun 'dignity' #noun 'dilate' #verb 'dilated' #verb 'doctor' #noun 'document' #noun 'dog' #noun 'doggie' #noun 'dogs' #noun 'drink' #verb 'drinks' #noun 'drive' #verb 'driver' #noun 'drizzle' #verb 'dry' #verb 'duck' #noun 'eagle' #noun 'eagles' #noun 'eaglet' #noun 'ear' #noun 'earache' #noun 'eardrum' #noun 'eardrums' #noun 'earlobe' #noun 'early' #adjective 'earn' #verb 'earning' #verb 'earphones' #noun 'earring' #noun 'earrings' #noun 'ears' #noun 'earth' #noun 'earthquake' #noun 'earthquakes' #noun 'earths' #noun 'earthworm' #noun 'earthworms' #noun 'earwax' #noun 'ease' #noun 'easel' #noun 'easier' #adjective 'easiest' #adjective 'easily' #adverb 'easiness' #noun 'east' #noun 'easter' #noun 'easy' #adjective 'eat' #verb 'eatable' #adjective 'eats' #verb 'ebony' #noun 'eccentric' #adjective 'eccentricity' #noun 'ecclesiastic' #noun 'echo' #noun 'eclipse' #noun 'ecologic' #adjective 'ecologist' #noun 'ecology' #noun 'economics' #noun 'ecru' #adjective 'eight' #adverb 'eighteen' #adverb 'eighteenth' #adjective 'eightfold' #adverb 'eighth' #adjective 'eighties' #noun 'eightieth' #adjective 'eighty' #adverb 'eightyfold' #adverb 'einsteinium' #noun 'either' #adverb 'ejaculate' #verb 'ejaculated' #adjective 'ejaculates' #verb 'ejaculating' #adjective 'ejaculation' #noun 'ejaculations' #noun 'ejaculatory' #adjective 'eject' #verb 'ejectable' #adjective 'ejecting' #verb 'ejection' #noun 'ejector' #noun 'ejectors' #noun 'elaborate' #verb 'elaborated' #adjective 'elaborates' #verb 'elaborating' #adjective 'elaboration' #noun 'elaborations' #noun 'elevator' #noun 'eleven' #adjective 'eleventh' #noun 'eliminate' #verb 'end' #noun 'environment' #noun 'environmental' #adjective 'envoy' #noun 'envy' #noun 'envy' #verb 'escalator' #noun 'establish' #verb 'event' #noun 'eventual' #adjective 'eventually' #adverb 'ever' #adverb 'evergreen' #adjective 'everlasting' #adjective 'every' #pronoun 'everywhere' #conjunction 'eviction' #noun 'evidence' #noun 'exclaim' #verb 'fable' #noun 'fables' #noun 'fabric' #noun 'fabricant' #noun 'fabricate' #verb 'fabricated' #pronoun 'fabricates' #verb 'fabricating' #verb 'fabrication' #noun 'fabrications' #noun 'fabricator' #noun 'fabricators' #noun 'fabrics' #noun 'fabulist' #noun 'fabulous' #adjective 'facade' #noun 'facades' #noun 'face' #noun 'faceless' #noun 'faceplate' #noun 'facet' #noun 'facetious' #adjective 'facetiously' #adverb 'facial' #adjective 'facies' #noun 'facile' #adjective 'facilitate' #verb 'facilitated' #pronoun 'facilitates' #verb 'facilitating' #verb 'facilities' #noun 'facility' #noun 'facing' #preposition 'facsimile' #noun 'fact' #noun 'faction' #noun 'factor' #noun 'factorials' #noun 'factories' #noun 'factorization' #noun 'factorizations' #noun 'factorize' #verb 'factorized' #adjective 'factors' #noun 'facts' #noun 'factual' #adjective 'facultative' #adjective 'facultatively' #adverb 'faculties' #noun 'fad' #verb 'fade' #verb 'faded' #adjective 'fader' #noun 'faders' #noun 'fading' #noun 'faery' #noun 'fail' #verb 'faint' #verb 'faintly' #adverb 'fair' #adjective 'fairly' #adverb 'fairy' #noun 'faith' #noun 'faithful' #adjective 'faithfully' #adverb 'fashion' #noun 'fashionable' #adjective 'fast' #adjective 'fasten' #verb 'fastener' #noun 'fastidious' #adjective 'fat' #adjective 'fatal' #adjective 'fatalism' #noun 'fatality' #noun 'fatally' #adverb 'fate' #noun 'fish' #noun 'fishable' #adverb 'fishbowl' #noun 'fished' #verb 'fisher' #noun 'fisheries' #noun 'fisherman' #noun 'fishermen' #noun 'fishers' #noun 'fishery' #noun 'fishes' #noun 'fishtail' #noun 'fission' #noun 'fissionable' #adverb 'fissure' #noun 'fist' #noun 'fisted' #verb 'fistful' #noun 'five' #adverb 'fivefold' #adverb 'fix' #verb 'fixation' #noun 'fixations' #noun 'fixity' #noun 'fixture' #noun 'fixtures' #noun 'fjord' #noun 'fjords' #noun 'flight' #noun 'floppy' #noun 'fluently' #adverb 'foot' #noun 'football' #noun 'forget' #verb 'forgetful' #adjective 'forgetfulness' #noun 'forgivable' #adjective 'forgivably' #adverb 'forgive' #verb 'forgiveness' #noun 'forgives' #verb 'forgiving' #adjective 'forgo' #verb 'forgoes' #verb 'forgotten' #adjective 'forlorn' #adjective 'four' #adverb 'fox' #noun 'fractal' #noun 'fractals' #noun 'fraction' #noun 'fractionate' #verb 'fraternal' #adjective 'fraternize' #verb 'friend' #noun 'friendship' #noun 'fringe' #noun 'frog' #noun 'frogs' #noun 'front' #preposition 'fucked' #adjective 'fudge' #noun 'fugue' #noun 'fulgurant' #adjective 'funk' #noun 'funniest' #adjective 'funny' #adjective 'gab' #verb 'gabardine' #noun 'gabber' #noun 'gabbing' #verb 'gaberdine' #noun 'gadget' #noun 'gaiety' #noun 'gaily' #adverb 'gain' #noun 'gained' #verb 'gaining' #verb 'gala' #noun 'galactic' #adjective 'galaxies' #noun 'galaxy' #noun 'gallant' #adjective 'gallantly' #adverb 'gallantry' #noun 'galleries' #noun 'gallery' #noun 'gallon' #noun 'gallop' #verb 'galloped' #verb 'galloping' #verb 'galvanic' #adjective 'galvanism' #noun 'galvanize' #verb 'galvanized' #verb 'game' #noun 'games' #noun 'garlic' #noun 'gas' #noun 'gasoline' #noun 'ghostwriter' #noun 'gift' #noun 'gifts' #noun 'go' #verb 'goal' #noun 'godfather' #noun 'gopher' #noun 'gospel' #noun 'grab' #verb 'gradient' #noun 'gradually' #adverb 'grammar' #noun 'grape' #noun 'grapefruit' #noun 'habilitated' #verb 'habilitation' #noun 'habit' #noun 'habitant' #noun 'habitants' #noun 'habitat' #noun 'habitation' #noun 'habitual' #adjective 'hand' #noun 'heats' #noun 'heaven' #noun 'heavy' #adjective 'hedgehog' #noun 'heed' #verb 'held' #adjective 'helices' #noun 'hell' #noun 'hello' #noun 'helm' #noun 'helmet' #noun 'help' #noun 'hemp' #noun 'hen' #noun 'herd' #noun 'here' #noun 'heron' #noun 'hips' #noun 'hit' #verb 'hockey' #noun 'hogwash' #noun 'holidayer' #noun 'home' #noun 'homeless' #noun 'homes' #noun 'house' #noun 'ice' #noun 'instancing' #noun 'jab' #verb 'jabber' #verb 'jabberwocky' #noun 'jack' #noun 'jackal' #noun 'jackals' #noun 'jackass' #noun 'jackdaw' #noun 'jacket' #noun 'jackhammer' #noun 'jackknife' #noun 'jackpot' #noun 'jade' #noun 'jaded' #adjective 'jag' #noun 'jagged' #verb 'jail' #verb 'jailbreak' #noun 'jailed' #adjective 'jailer' #noun 'jailing' #noun 'jailor' #noun 'jails' #noun 'jalopy' #noun 'jam' #noun 'jam' #verb 'jamb' #noun 'jammed' #adjective 'jangle' #verb 'janitor' #noun 'jar' #noun 'jargon' #noun 'jasmine' #noun 'jaundice' #noun 'jaunt' #noun 'jaunty' #adjective 'javelin' #noun 'jaw' #noun 'jaws' #noun 'jay' #noun 'jazz' #noun 'jazzy' #adjective 'jealous' #adjective 'jealousy' #noun 'jeer' #verb 'jelly' #noun 'jellyfish' #noun 'jeopardize' #verb 'jerk' #noun 'jerk' #verb 'jerry' #noun 'jersey' #noun 'jest' #noun 'jester' #noun 'jet' #noun 'jettison' #verb 'jetty' #noun 'jewel' #noun 'jeweler' #noun 'jewelery' #noun 'jewelry' #noun 'jewels' #noun 'jib' #noun 'jig' #noun 'jigsaw' #noun 'jihad' #noun 'jilt' #verb 'jingle' #verb 'jingle' #noun 'jinx' #noun 'jitters' #noun 'job' #noun 'jobless' #adjective 'jockey' #noun 'jocular' #adjective 'jocund' #adjective 'jodhpur' #noun 'jog' #verb 'jogging' #noun 'join' #verb 'join' #noun 'joinable' #adverb 'joined' #adjective 'joiner' #noun 'joinery' #noun 'joint' #noun 'jointly' #adverb 'joke' #noun 'joked' #verb 'joker' #noun 'jokingly' #adverb 'jolly' #adjective 'jolt' #noun 'jonquils' #noun 'jostle' #verb 'jot' #verb 'journal' #noun 'journalist' #noun 'journalists' #noun 'journey' #noun 'jovial' #adjective 'jovially' #adverb 'joy' #noun 'joyful' #adjective 'joyfully' #adverb 'joyless' #adverb 'joyously' #adverb 'jubilant' #adjective 'jubilee' #noun 'judge' #noun 'judge' #verb 'judged' #adjective 'judgement' #noun 'judicial' #adjective 'judiciary' #noun 'judo' #noun 'jug' #noun 'juggernaut' #noun 'juggle' #verb 'juggler' #noun 'jugular' #adjective 'juice' #noun 'jukebox' #noun 'jumble' #noun 'jumbo' #adjective 'jump' #verb 'jumped' #verb 'jumper' #noun 'jumpy' #adjective 'junction' #noun 'jungle' #noun 'juniper' #noun 'junk' #noun 'junkers' #noun 'junkie' #noun 'junkyard' #noun 'juridic' #adjective 'jurisdiction' #noun 'jurist' #noun 'juror' #noun 'jurors' #noun 'jury' #noun 'justice' #noun 'justified' #adjective 'justify' #verb 'justly' #adverb 'jut' #verb 'juvenile' #adjective 'juxtapose' #verb 'kale' #noun 'kaleidescope' #noun 'kaleidoscope' #noun 'kangaroo' #noun 'karat' #noun 'karate' #noun 'kayak' #noun 'kebab' #noun 'keel' #noun 'keep' #verb 'keeps' #noun 'keepsake' #noun 'keg' #noun 'kennel' #noun 'kerchief' #noun 'kernel' #noun 'kerosene' #noun 'ketchup' #noun 'kettle' #noun 'key' #noun 'keyboard' #noun 'keyhole' #noun 'keying' #verb 'keynote' #noun 'keypad' #noun 'khaki' #adjective 'kick' #verb 'kickback' #noun 'kicked' #adjective 'kicker' #noun 'kickoff' #noun 'kid' #noun 'kiddies' #noun 'kidnap' #verb 'kidnaped' #adjective 'kidnaper' #noun 'kidnapers' #noun 'kidnaping' #noun 'kidnapped' #verb 'kidnapper' #noun 'kidnappers' #noun 'kidnapping' #noun 'kidnappings' #noun 'kidney' #noun 'kidneys' #noun 'kids' #noun 'kill' #verb 'killer' #noun 'killers' #noun 'killing' #noun 'killings' #noun 'killjoy' #noun 'kiln' #noun 'kilo' #noun 'kilobytes' #noun 'kilogram' #noun 'kilohertz' #noun 'kiloliter' #noun 'kilowatt' #noun 'kilt' #noun 'kin' #adjective 'kind' #adjective 'kind' #noun 'kind' #adjective 'kindergarten' #noun 'kindhearted' #noun 'kindhearted' #adjective 'kindheartedness' #noun 'kindle' #verb 'kindlessly' #adverb 'kindliness' #noun 'kindly' #adverb 'kindness' #noun 'kindred' #adjective 'kinds' #noun 'king' #noun 'kingdom' #noun 'kingdoms' #noun 'kingfisher' #noun 'kingly' #adjective 'kings' #noun 'kinky' #adjective 'kiosk' #noun 'kipper' #noun 'kiss' #verb 'kiss' #noun 'kiss' #verb 'kisses' #noun 'kit' #noun 'kitchen' #noun 'kitchenette' #noun 'kitchenware' #noun 'kite' #noun 'kiting' #verb 'kitten' #noun 'kittens' #noun 'kitty' #noun 'kiwi' #noun 'kleenex' #noun 'kleptomania' #noun 'kleptomaniac' #noun 'knack' #noun 'knapsack' #noun 'knead' #verb 'kneadable' #adjective 'kneader' #noun 'knee' #noun 'kneecap' #noun 'kneel' #verb 'kneeling' #adverb 'kneeling' #verb 'kneepad' #noun 'knelt' #verb 'knickers' #noun 'knickknack' #noun 'knife' #noun 'knifes' #noun 'knifing' #noun 'knight' #noun 'knighted' #adjective 'knighthood' #noun 'knightly' #adjective 'knights' #noun 'knit' #verb 'knitted' #adjective 'knitting' #noun 'knitwear' #noun 'knives' #noun 'knob' #noun 'knobby' #adjective 'knobs' #noun 'knock' #verb 'knockdown' #verb 'knockout' #noun 'knot' #noun 'knots' #noun 'knotted' #adjective 'knotty' #adjective 'know' #verb 'knower' #noun 'knowhow' #noun 'knowing' #adjective 'knowingly' #adverb 'knowledge' #noun 'knowledgeable' #adjective 'known' #verb 'knows' #verb 'knuckle' #noun 'knucklebone' #noun 'knuckles' #noun 'koala' #noun 'kosher' #adjective 'kraut' #noun 'krauts' #noun 'kudzu' #noun 'lab' #noun 'labor' #noun 'laborer' #noun 'laborers' #noun 'laborious' #noun 'labyrinth' #noun 'lace' #noun 'laceration' #noun 'lacerations' #noun 'lack' #noun 'lackadaisical' #adjective 'lackey' #noun 'lacking' #adjective 'lackluster' #adjective 'laconic' #adjective 'laconically' #adjective 'lacquer' #noun 'lad' #noun 'ladies' #noun 'lady' #noun 'ladybird' #noun 'ladybug' #noun 'lake' #noun 'lakes' #noun 'lamb' #noun 'lambs' #noun 'laminated' #verb 'laminates' #verb 'lamp' #noun 'language' #noun 'laugh' #verb 'leather' #noun 'leave' #verb 'lectern' #noun 'lecture' #noun 'lecturer' #noun 'ledge' #noun 'ledger' #noun 'lee' #noun 'leg' #noun 'legal' #adjective 'legality' #noun 'legalize' #noun 'legally' #adverb 'legate' #verb 'legation' #noun 'legend' #noun 'legendary' #adjective 'legion' #verb 'like' #verb 'live' #verb 'love' #noun 'lover' #noun 'luck' #noun 'lunch' #noun 'ma' #noun 'macabre' #adjective 'macabrely' #adverb 'macadam' #noun 'macadamize' #verb 'macadamized' #verb 'macadamized' #adjective 'macadamizes' #verb 'macadamizing' #verb 'macaque' #noun 'macaroni' #noun 'macaronies' #noun 'macaroon' #noun 'macaw' #noun 'mace' #noun 'macerate' #verb 'macerated' #adjective 'maceration' #noun 'macerations' #noun 'maces' #noun 'machete' #noun 'machination' #noun 'machine' #noun 'machined' #adjective 'machinery' #noun 'machines' #noun 'machinist' #noun 'machinists' #noun 'machismo' #noun 'macho' #adjective 'macrocephalic' #adjective 'macrocosm' #noun 'macroeconomics' #noun 'macroevolution' #noun 'macroevolutionary' #adjective 'macromolecular' #adjective 'macromolecule' #noun 'macromolecules' #noun 'macropathological' #adjective 'macropathology' #noun 'macrophage' #noun 'macrophages' #noun 'macrophagic' #adjective 'macroprocessor' #noun 'macroscopic' #adjective 'macrosimulation' #noun 'macrostructure' #noun 'maculate' #verb 'maculated' #adjective 'maculates' #verb 'maculation' #noun 'maculations' #noun 'mad' #adjective 'madam' #noun 'madams' #noun 'maddened' #adjective 'made' #verb 'mademoiselle' #noun 'mademoiselles' #noun 'maestro' #noun 'mafioso' #noun 'magazine' #noun 'magic' #adjective 'magician' #noun 'magicians' #noun 'magistral' #adjective 'magistrally' #adverb 'magistrature' #noun 'magma' #noun 'me' #pronoun 'mead' #noun 'meadow' #noun 'meadowland' #noun 'meadows' #noun 'meager' #adjective 'meagerly' #adverb 'meagre' #adjective 'meal' #noun 'meals' #noun 'mealtime' #noun 'mean' #noun 'meander' #noun 'meaningless' #adjective 'meanings' #noun 'means' #noun 'meanwhile' #adverb 'measurable' #adjective 'meat' #noun 'meatball' #noun 'meatballs' #noun 'mechanical' #adjective 'mechanician' #noun 'mechanism' #noun 'mechanisms' #noun 'medal' #noun 'medallion' #noun 'medallions' #noun 'mediatrice' #noun 'mediatrix' #noun 'medic' #noun 'medical' #adjective 'medically' #conjunction 'medicament' #noun 'medicaments' #noun 'medicinal' #adjective 'medicine' #noun 'medicines' #noun 'medico' #adjective 'medicolegal' #adjective 'medics' #noun 'medieval' #adjective 'medievalist' #noun 'medievalists' #noun 'mediocre' #adjective 'mediocrities' #noun 'mediocrity' #noun 'meditate' #verb 'meditates' #verb 'meditation' #noun 'meditations' #noun 'meditative' #adjective 'meditatively' #adjective 'medium' #noun 'medlar' #noun 'medley' #noun 'medleys' #noun 'medulla' #noun 'medusae' #noun 'meek' #adjective 'meekly' #adjective 'meekness' #noun 'meerschaum' #noun 'megabyte' #noun 'megabytes' #noun 'megacycle' #noun 'megahertz' #noun 'megalith' #noun 'megalithic' #adjective 'megalomania' #noun 'megalomaniac' #noun 'megalomaniacal' #adjective 'megaphone' #noun 'melancholia' #noun 'melancholic' #adjective 'melange' #noun 'melodic' #adjective 'melodies' #noun 'melodious' #adjective 'melodrama' #noun 'melodramas' #noun 'melodramatic' #adjective 'melody' #noun 'melon' #noun 'melons' #noun 'melted' #pronoun 'member' #noun 'members' #noun 'membrane' #noun 'membranes' #noun 'membranous' #adjective 'memoir' #noun 'memoirs' #noun 'memorable' #adjective 'memories' #noun 'memorize' #verb 'memorized' #pronoun 'memory' #noun 'men' #noun 'menace' #noun 'menaced' #adjective 'menagerie' #noun 'menageries' #noun 'menhir' #noun 'meningitis' #noun 'meniscus' #noun 'menopause' #noun 'menstrual' #adjective 'menstruation' #noun 'menstruations' #noun 'mental' #adjective 'mentality' #noun 'menthol' #noun 'mention' #verb 'menu' #noun 'meow' #verb 'meowing' #adjective 'meows' #verb 'mephitic' #adjective 'mercantile' #adjective 'mercantilism' #noun 'mercenaries' #noun 'mercenary' #noun 'merchant' #noun 'merchants' #noun 'mercury' #noun 'mercy' #noun 'meridian' #noun 'meridians' #noun 'meridional' #adjective 'merino' #noun 'merit' #noun 'meritocracy' #noun 'merits' #noun 'mermaid' #noun 'mermaids' #noun 'merry' #adjective 'message' #noun 'messages' #noun 'messiahs' #noun 'messianic' #adjective 'moan' #verb 'moaned' #verb 'moaning' #verb 'moat' #noun 'moats' #noun 'mob' #noun 'mock' #verb 'mocked' #verb 'mockery' #noun 'modal' #adjective 'moon' #noun 'naive' #adjective 'naively' #adverb 'naked' #noun 'name' #noun 'named' #adjective 'nameless' #adjective 'namely' #adverb 'names' #noun 'national' #adjective 'nationalism' #noun 'nationalist' #adjective 'native' #noun 'natural' #adjective 'naturalize' #verb 'naturally' #adverb 'neap' #noun 'near' #adjective 'nearby' #adverb 'nearer' #adjective 'neglect' #verb 'neighbor' #noun 'neighbors' #noun 'nine' #adjective 'nineteen' #adverb 'nineteenth' #adjective 'nineties' #noun 'ninetieth' #adjective 'ninety' #adverb 'ninetyfold' #adverb 'ninth' #adjective 'niobium' #noun 'nip' #noun 'nipple' #noun 'nipples' #noun 'nips' #noun 'nirvana' #noun 'nitrate' #noun 'nitrated' #noun 'nitrates' #noun 'nitrating' #adverb 'nitration' #noun 'nitrations' #noun 'nitric' #adjective 'nitride' #noun 'nitrogen' #noun 'nitroglycerin' #noun 'nitroglycerine' #noun 'noble' #noun 'nobleman' #noun 'noblemen' #noun 'nobleness' #noun 'nobody' #pronoun 'noctambulism' #noun 'noctambulist' #noun 'nocturnally' #noun 'now' #adverb 'nowadays' #adverb 'noway' #adverb 'oaf' #noun 'oafish' #adjective 'oafishness' #noun 'oak' #noun 'oar' #noun 'oarsman' #noun 'oasis' #noun 'oat' #noun 'oath' #noun 'oatmeal' #noun 'obdurate' #adjective 'obedience' #noun 'obedient' #adjective 'obelisk' #noun 'obese' #adjective 'obesity' #noun 'ocean' #noun 'one' #noun 'orange' #noun 'oranges' #noun 'orbit' #noun 'orbital' #adjective 'orbits' #noun 'orchestra' #noun 'orchestral' #adjective 'orchestras' #noun 'orchestrated' #adjective 'order' #noun 'ordered' #adjective 'organism' #noun 'organisms' #noun 'organist' #noun 'organists' #noun 'organization' #noun 'organizations' #noun 'organize' #verb 'organized' #adjective 'organs' #noun 'orgasm' #noun 'orgasms' #noun 'orgies' #noun 'orgy' #noun 'orient' #noun 'orientable' #adjective 'oriental' #adjective 'orientation' #noun 'orientations' #noun 'oriented' #adjective 'orients' #noun 'orifice' #noun 'orifices' #noun 'orificial' #adjective 'origin' #noun 'original' #adjective 'originality' #adjective 'originally' #adverb 'originals' #adjective 'origins' #noun 'ornamental' #adjective 'ornithology' #noun 'orthodox' #adjective 'orthodoxes' #adjective 'orthogonal' #adjective 'pace' #noun 'pacemaker' #noun 'pachyderm' #noun 'pacific' #noun 'pacifically' #adverb 'pacification' #noun 'pacifications' #noun 'pacificist' #noun 'pacifism' #noun 'pacifist' #noun 'pacify' #verb 'package' #noun 'packaged' #adverb 'packaged' #noun 'packet' #noun 'packing' #noun 'pact' #noun 'pacts' #noun 'pad' #noun 'padding' #noun 'paddle' #noun 'paddock' #noun 'padlock' #noun 'padlock' #verb 'padrone' #noun 'paella' #noun 'pagan' #noun 'pagans' #noun 'pageant' #noun 'pageantry' #noun 'paid' #adjective 'pail' #noun 'pain' #noun 'pained' #adjective 'painful' #adjective 'painfully' #adverb 'painstaking' #adjective 'paint' #verb 'paint' #noun 'paintbrush' #noun 'painter' #noun 'painters' #noun 'painting' #noun 'paints' #noun 'pair' #noun 'pajamas' #noun 'pal' #noun 'palace' #noun 'palatable' #adjective 'palaver' #noun 'pale' #adjective 'palette' #noun 'pall' #noun 'pallet' #noun 'pallette' #noun 'pallor' #noun 'palm' #noun 'palpable' #adjective 'paltry' #adjective 'pamper' #verb 'pamphlet' #noun 'pan' #noun 'panacea' #noun 'panama' #noun 'pancake' #noun 'panda' #noun 'pandemonium' #noun 'pane' #noun 'panel' #noun 'paneling' #noun 'panelling' #noun 'pang' #noun 'panic' #noun 'panic' #verb 'panicky' #adjective 'panorama' #noun 'pansy' #noun 'pant' #verb 'panther' #noun 'panties' #noun 'pantry' #noun 'pants' #noun 'papa' #noun 'paper' #noun 'paperback' #noun 'parameter' #noun 'passer' #noun 'passion' #noun 'passionately' #adverb 'passive' #adjective 'passivity' #noun 'password' #noun 'passwords' #noun 'past' #noun 'pasta' #noun 'peat' #noun 'pectorals' #noun 'penitence' #noun 'penitences' #noun 'penitency' #noun 'penitent' #noun 'pentadactyl' #adjective 'pentadactylism' #noun 'pi' #noun 'pianist' #noun 'pianistic' #adjective 'piano' #noun 'picture' #noun 'pictures' #noun 'pie' #noun 'pies' #noun 'pig' #noun 'pigeonhole' #noun 'pigment' #noun 'pigmentation' #noun 'pigments' #noun 'pigs' #noun 'pilot' #noun 'pilots' #noun 'pilule' #noun 'pine' #noun 'pineapple' #noun 'pineapples' #noun 'pines' #noun 'pink' #noun 'pocket' #noun 'pocketbook' #noun 'pocketbooks' #noun 'pockets' #noun 'podium' #noun 'pogrom' #noun 'pogroms' #noun 'pointer' #noun 'pointers' #noun 'pointillism' #noun 'pointillist' #noun 'pointilliste' #noun 'pointillistic' #noun 'poison' #noun 'poisonous' #adjective 'poisonousness' #noun 'poisons' #noun 'polar' #adjective 'polarities' #noun 'polarity' #noun 'polarize' #verb 'polarized' #adjective 'polemical' #adjective 'polemically' #adjective 'polemically' #adverb 'police' #noun 'policeman' #noun 'policemen' #noun 'policewoman' #noun 'policewomen' #noun 'policy' #noun 'polish' #adjective 'polish' #noun 'polite' #adjective 'politely' #adverb 'politeness' #noun 'political' #adjective 'politically' #adverb 'politician' #noun 'politicians' #noun 'politics' #noun 'polka' #noun 'pollutant' #noun 'pollute' #verb 'polluted' #adjective 'polluter' #noun 'pollution' #noun 'polonium' #noun 'poltergeist' #noun 'polyandrous' #adjective 'polyandry' #noun 'pour' #noun 'pout' #noun 'poverty' #noun 'powder' #noun 'powdery' #adjective 'power' #noun 'powerful' #adjective 'powerless' #adjective 'powwow' #noun 'practicability' #noun 'practicable' #adjective 'practical' #adjective 'pray' #verb 'prayer' #noun 'prayers' #noun 'praying' #adjective 'praying' #noun 'preach' #verb 'preacher' #noun 'preachers' #noun 'preaches' #verb 'preachify' #verb 'preaching' #noun 'preaching' #adjective 'preaching' #noun 'preachy' #adjective 'preamplifier' #noun 'preamplifiers' #noun 'prearrange' #verb 'prince' #noun 'princely' #adjective 'princes' #verb 'princess' #noun 'principal' #noun 'principalities' #noun 'principle' #noun 'print' #noun 'printable' #adjective 'printed' #adjective 'printer' #noun 'prove' #verb 'pulse' #noun 'pulverizable' #adjective 'pulverizables' #adjective 'pulverization' #noun 'pulverize' #verb 'pulverized' #verb 'pulverizer' #noun 'pulverizers' #noun 'pulverizes' #verb 'pulverizing' #verb 'puma' #noun 'pump' #verb 'push' #verb 'pushchair' #noun 'pushing' #verb 'put' #verb 'putdown' #verb 'putout' #verb 'putrefaction' #noun 'quail' #noun 'quails' #noun 'quake' #verb 'quality' #noun 'qualm' #noun 'qualms' #noun 'quarrel' #verb 'quarry' #noun 'quarter' #noun 'quarterdeck' #noun 'quarterfinal' #noun 'queen' #noun 'queer' #adjective 'quell' #verb 'querulous' #adjective 'query' #noun 'quest' #noun 'question' #noun 'queue' #noun 'quibble' #verb 'quick' #adjective 'quicklime' #noun 'quickly' #adverb 'quicksand' #noun 'quicksilver' #noun 'quiet' #adjective 'quieten' #verb 'quietly' #adverb 'quill' #noun 'quilt' #noun 'quirk' #noun 'quit' #verb 'quite' #adjective 'quota' #noun 'quotation' #noun 'quote' #verb 'r' #noun 'rabbet' #noun 'rabbinic' #adjective 'rabbit' #noun 'rabbits' #noun 'rabble' #noun 'rabid' #adjective 'race' #noun 'racemic' #adjective 'races' #noun 'rachis' #noun 'rachitic' #adjective 'rachitis' #noun 'racial' #adjective 'racialism' #noun 'racialist' #noun 'racialistic' #adjective 'racism' #noun 'racist' #noun 'rack' #noun 'racket' #noun 'radar' #noun 'radars' #noun 'radio' #noun 'read' #verb 'readability' #noun 'readable' #adjective 'reader' #noun 'readers' #noun 'readership' #noun 'readily' #adverb 'readiness' #noun 'reading' #noun 'readings' #noun 'readjust' #verb 'readjusts' #verb 'readout' #noun 'readout' #adjective 'readouts' #noun 'reads' #verb 'ready' #adjective 'reaffirm' #verb 'reaffirms' #verb 'reagent' #noun 'real' #adjective 'realisable' #adjective 'realism' #noun 'realist' #noun 'realistic' #adjective 'realistically' #adverb 'reality' #noun 'realize' #verb 'really' #adverb 'reporter' #noun 'represent' #verb 'request' #noun 'request' #verb 'request' #noun 'road' #noun 'roadwork' #noun 'robber' #noun 'rotting' #verb 'sabbat' #noun 'sabbath' #noun 'sabbatic' #noun 'sabbatical' #adjective 'saber' #noun 'sabin' #noun 'sable' #noun 'sabot' #noun 'sabotage' #noun 'sabotaged' #verb 'sabotages' #noun 'saboteur' #noun 'sabra' #noun 'sabras' #noun 'saccade' #noun 'saccharin' #verb 'saccharine' #noun 'saccharose' #noun 'sacerdotal' #adjective 'sacerdotally' #adverb 'sachet' #noun 'sack' #noun 'sack' #verb 'sackcloth' #noun 'sacked' #adjective 'sackful' #adjective 'sacks' #verb 'sacrament' #noun 'sacramental' #adjective 'sacraments' #noun 'sacre' #noun 'sacred' #adjective 'sacrifice' #noun 'sacrificed' #verb 'sacrifices' #noun 'sacrilege' #noun 'sad' #adjective 'sadden' #verb 'sadder' #adjective 'saddest' #adjective 'saddle' #noun 'saddlebag' #noun 'saddlecloth' #noun 'saddled' #verb 'saddler' #noun 'saddlery' #noun 'saddletree' #noun 'saddling' #verb 'sadism' #noun 'sadist' #noun 'sadistic' #adjective 'sadistically' #adverb 'sadists' #noun 'sadly' #adverb 'sadness' #noun 'safari' #noun 'safe' #noun 'safecracker' #noun 'safecracking' #noun 'safeguard' #noun 'safeguarded' #verb 'safeguards' #noun 'safer' #adjective 'safes' #noun 'safest' #adjective 'safety' #noun 'safflower' #noun 'saffron' #noun 'sag' #verb 'saga' #noun 'sagacious' #adjective 'sagaciously' #adverb 'sagaciousness' #noun 'sagacity' #noun 'sage' #noun 'sagely' #adjective 'sago' #noun 'saguaro' #noun 'sahib' #noun 'said' #verb 'sail' #verb 'sail' #noun 'sailable' #adjective 'sailboat' #noun 'sailboater' #noun 'sailcloth' #noun 'sailor' #noun 'sailors' #noun 'sails' #noun 'sainfoin' #noun 'saint' #noun 'sainted' #adjective 'sainthood' #noun 'saints' #noun 'saith' #verb 'sake' #noun 'salability' #adjective 'salacious' #adjective 'salad' #noun 'salads' #noun 'salamander' #noun 'salami' #noun 'salaried' #adjective 'salaries' #noun 'sale' #noun 'saleable' #adjective 'saleroom' #noun 'sales' #noun 'salesgirl' #noun 'saleslady' #noun 'salesman' #noun 'salesmanship' #noun 'salesmen' #noun 'salespeople' #noun 'salesperson' #noun 'salesroom' #noun 'saleswomen' #noun 'salient' #adjective 'saline' #adjective 'salinity' #noun 'salinometer' #noun 'salinometers' #noun 'saliva' #noun 'salivary' #adjective 'salivate' #verb 'salivated' #verb 'salivates' #verb 'salivating' #verb 'salivation' #noun 'sallies' #noun 'sallow' #adjective 'sallowish' #adjective 'salmon' #noun 'salmons' #noun 'salon' #noun 'salons' #noun 'salt' #noun 'saltwater' #noun 'saltworks' #noun 'saltwort' #noun 'salty' #adjective 'salubrious' #adjective 'salubrity' #noun 'salvage' #noun 'salver' #noun 'samba' #noun 'same' #adjective 'sampan' #noun 'samphire' #noun 'samurai' #noun 'samurais' #noun 'sand' #noun 'sandal' #noun 'school' #noun 'sea' #noun 'sell' #verb 'seller' #noun 'sellers' #noun 'serendipity' #verb 'seven' #adverb 'sevenfold' #adverb 'seventeen' #adverb 'seventeenth' #adjective 'seventh' #adjective 'seventies' #noun 'seventieth' #adjective 'seventy' #adverb 'seventyfold' #adverb 'sever' #verb 'severalfold' #adverb 'severe' #adjective 'severed' #adjective 'severely' #adverb 'severities' #noun 'severity' #noun 'sewage' #noun 'sex' #noun 'sexagenarian' #adjective 'shades' #noun 'shadow' #noun 'shadows' #noun 'shagreen' #noun 'shah' #noun 'shake' #verb 'shakedown' #noun 'shaken' #adjective 'shaky' #adjective 'shaman' #noun 'shamanism' #noun 'sheep' #noun 'sheepherder' #noun 'ship' #noun 'shit' #noun 'sick' #adverb 'silver' #adjective 'sing' #verb 'singer' #noun 'sink' #verb 'six' #adverb 'sixteen' #adverb 'sixteenth' #adjective 'sixties' #noun 'sixty' #adverb 'sixtyfold' #adverb 'size' #noun 'skate' #noun 'skateboard' #noun 'skateboarder' #noun 'skateboarding' #verb 'skateboards' #noun 'skater' #noun 'skaters' #noun 'skates' #noun 'skating' #noun 'skill' #noun 'skilled' #adjective 'skilless' #adjective 'skillful' #adjective 'skills' #noun 'sky' #noun 'skylark' #noun 'skyscraper' #noun 'snout' #noun 'snow' #noun 'snowball' #noun 'snowman' #noun 'snowstorm' #noun 'software' #noun 'sorrel' #noun 'sorrily' #adverb 'sorrow' #noun 'sort' #verb 'sorted' #adjective 'sorter' #noun 'soul' #noun 'spectra' #noun 'spectrum' #noun 'speculate' #verb 'staple' #noun 'stapled' #adjective 'stapler' #noun 'staplers' #noun 'staples' #noun 'star' #noun 'stars' #noun 'start' #noun 'strength' #noun 'stupid' #adjective 'subject' #noun 'succeed' #verb 'success' #noun 'sun' #noun 'sunbathe' #verb 'sunny' #adjective 'suspect' #verb 'swear' #verb 'tab' #adjective 'tab' #verb 'tabernacle' #noun 'table' #noun 'tableau' #noun 'tableaus' #noun 'tableaux' #noun 'tablecloth' #noun 'tablecloths' #noun 'tables' #noun 'tablet' #noun 'tablets' #noun 'taboo' #noun 'taboos' #noun 'tachometer' #noun 'tachometers' #noun 'tacit' #adjective 'tail' #noun 'tailor' #noun 'tailored' #adjective 'tailors' #noun 'tails' #noun 'task' #noun 'tasks' #noun 'taste' #noun 'tasted' #verb 'tasteless' #adjective 'tear' #noun 'tear' #verb 'tear' #noun 'teardrop' #noun 'tearful' #adjective 'tearfully' #adverb 'teargas' #noun 'tearjerker' #noun 'tearless' #adjective 'tearoom' #noun 'tears' #noun 'tearstained' #adjective 'tease' #noun 'tease' #verb 'teasel' #noun 'teaser' #noun 'teases' #verb 'teases' #noun 'teasing' #adjective 'teasing' #noun 'teasingly' #adverb 'teasingly' #verb 'teaspoon' #noun 'teaspoonful' #noun 'teat' #noun 'teatime' #noun 'teats' #noun 'ten' #adverb 'tendencies' #noun 'tendency' #noun 'tenderfoot' #noun 'tenderly' #adverb 'thence' #adverb 'thenceforth' #adverb 'thenceforward' #adverb 'theocracy' #noun 'theocratic' #adjective 'theodolite' #noun 'theologian' #noun 'theological' #adjective 'theologically' #adverb 'theology' #noun 'theorem' #noun 'theorems' #noun 'theoretical' #adjective 'theoretically' #adverb 'theoretician' #noun 'theoreticians' #noun 'theories' #noun 'theorist' #noun 'theorists' #noun 'theorize' #verb 'thief' #noun 'though' #adverb 'though' #conjunction 'thought' #noun 'thoughtful' #adjective 'thoughtfully' #adverb 'thoughtfulness' #adjective 'thoughtless' #adjective 'thoughtlessly' #adverb 'thoughtlessness' #noun 'thousand' #noun 'thousandth' #noun 'thrash' #verb 'thread' #verb 'thread' #noun 'threadbare' #adjective 'threat' #noun 'threaten' #verb 'threatening' #adjective 'threateningly' #adverb 'three' #article 'tigress' #noun 'today' #noun 'toe' #noun 'tradition' #noun 'traditional' #adjective 'trail' #noun 'train' #noun 'trainee' #noun 'trainer' #noun 'traitor' #noun 'transaction' #noun 'transalpine' #adjective 'transcribe' #verb 'transfer' #noun 'translate' #verb 'translation' #noun 'translator' #noun 'transmit' #verb 'tree' #noun 'two' #article 'ubiquitous' #adjective 'ubiquity' #noun 'udder' #noun 'uglier' #adjective 'ugliest' #adjective 'uglify' #verb 'ugliness' #noun 'ugly' #adjective 'ukulele' #noun 'ulcer' #noun 'ulcerate' #verb 'ulcerated' #adjective 'ulceration' #noun 'ulcerative' #adjective 'ulna' #noun 'ultimo' #adverb 'unemployment' #noun 'vacant' #adjective 'vacate' #verb 'vacation' #noun 'vaccinate' #verb 'vaccinated' #noun 'vacuum' #noun 'vacuumed' #verb 'vagina' #noun 'vagrant' #noun 'vague' #adjective 'vain' #adjective 'wacky' #adjective 'wag' #verb 'walnut' #noun 'warehouse' #noun 'warehouses' #noun 'wash' #verb 'weep' #verb 'weeping' #noun 'weeping' #adjective 'weeps' #verb 'weepy' #adjective 'weepy' #noun 'weevil' #noun 'weft' #noun 'weigh' #verb 'weighing' #noun 'weighings' #noun 'weighs' #verb 'weight' #noun 'weighted' #adjective 'weightily' #adverb 'weighting' #noun 'weightless' #adjective 'weightlessness' #noun 'weights' #verb 'weights' #noun 'weighty' #adjective 'weir' #noun 'weird' #adjective 'weirdie' #noun 'weirdies' #noun 'weirdly' #adverb 'weirdness' #noun 'weirdo' #noun 'weirdos' #noun 'weirs' #noun 'welcome' #adjective 'welcome' #noun 'welcome' #verb 'where' #adjective 'window' #noun 'windowpane' #noun 'windshield' #noun 'windstorm' #noun 'windup' #verb 'wine' #noun 'wineglass' #noun 'winegrower' #noun 'winemaker' #noun 'winemaking' #noun 'winepress' #noun 'wines' #noun 'winey' #adjective 'wing' #noun 'winglet' #noun 'wink' #noun 'wire' #noun 'wire' #verb 'wired' #adjective 'wireless' #adjective 'wiring' #noun 'wisdom' #noun 'wise' #adjective 'wisecrack' #noun 'wisely' #adverb 'wiser' #adjective 'wish' #noun 'wish' #verb 'wishbone' #noun 'wishes' #noun 'wishful' #adjective 'witch' #noun 'witches' #noun 'with' #conjunction 'withdraw' #verb 'witness' #verb 'witness' #noun 'witnesses' #noun 'wolverine' #noun 'world' #noun 'worldwide' #adjective 'xenophobe' #noun 'xenophobia' #noun 'xenophobic' #adjective 'xerographic' #adjective 'xylem' #noun 'xylene' #noun 'xylophone' #noun 'xylophones' #noun 'xylophonist' #noun 'xylose' #noun 'xylotomic' #adjective 'yacht' #noun 'yachting' #noun 'yak' #noun 'yam' #noun 'yank' #verb 'yap' #verb 'yard' #noun 'yardstick' #noun 'yarn' #noun 'yawn' #noun 'yawn' #verb 'yawning' #noun 'year' #noun 'yearbook' #noun 'yearlong' #noun 'yearly' #adjective 'yearly' #adverb 'yearn' #verb 'yearning' #noun 'yearningly' #adjective 'years' #noun 'yeast' #noun 'yell' #noun 'yell' #verb 'yellow' #adjective 'yellowed' #adjective 'yellowing' #adjective 'yellowish' #adjective 'yesterday' #noun 'yet' #adverb 'yew' #noun 'yield' #verb 'yoga' #noun 'yoghurt' #noun 'yogurt' #noun 'yoke' #noun 'yolk' #noun 'you' #pronoun 'young' #adjective 'younger' #adjective 'youngster' #noun 'youth' #adjective 'youthful' #adjective 'yuppie' #noun 'zabaglione' #noun 'zany' #adjective 'zazen' #noun 'zeal' #noun 'zealous' #adjective 'zebra' #noun 'zenith' #noun 'zero' #noun 'zest' #noun 'zigzag' #verb 'zinc' #noun 'zipper' #noun 'zodiac' #noun 'zone' #noun 'zoo' #noun 'zoology' #noun 'zoom' #verb 'zucchini' #noun)! ! !TLWordClassifier class methodsFor: 'initialization' stamp: 'lr 5/4/2011 20:31'! initialize ClassificationTable := Dictionary new. self database pairsDo: [ :word :class | ClassificationTable at: word put: (ClassificationTable at: word ifAbsent: [ #() ]) , (Array with: class) ]! ! !TLWordClassifier class methodsFor: 'accessing' stamp: 'lr 5/4/2011 20:40'! types ^ ClassificationTable inject: Set new into: [ :set :types | set addAll: types; yourself ]! ! Object subclass: #TLWritingStyle instanceVariableNames: 'name rules' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLWritingStyle class methodsFor: 'instance creation' stamp: 'JorgeRessia 5/10/2010 11:52'! named: aString formedBy: anArray ^self new initializeNamed: aString formedBy: anArray ! ! !TLWritingStyle class methodsFor: 'accessing' stamp: 'lr 10/25/2010 19:39'! scientificPaperStyle | rules | rules := TLTextLintRule allRules reject: [ :each | each class = TLWordRepetitionInParagraphRule ]. ^ TLWritingStyle named: 'Scientific Paper Style' formedBy: rules! ! !TLWritingStyle class methodsFor: 'accessing' stamp: 'JorgeRessia 11/4/2010 10:14'! scientificPaperStyle2 | rules rulesContainer | rulesContainer := TLPhrasePatternRulesContainer new. rules := OrderedCollection new. rules addAll: ( rulesContainer allRules ); add: TLConnectorRepetitionInParagraphRule new. ^ TLWritingStyle named: 'Scientific Paper Style' formedBy: rules! ! !TLWritingStyle methodsFor: 'composing' stamp: 'JorgeRessia 5/12/2010 20:29'! + aWritingStyle ^TLWritingStyle named: (self name, ' + ', aWritingStyle name) formedBy: (self rules addAll: aWritingStyle rules; yourself)! ! !TLWritingStyle methodsFor: 'composing' stamp: 'JorgeRessia 5/12/2010 20:35'! - aWritingStyle ^TLWritingStyle named: (self name, ' - ', aWritingStyle name) formedBy: (self rules removeAllFoundIn: aWritingStyle rules; yourself)! ! !TLWritingStyle methodsFor: 'testing' stamp: 'JorgeRessia 5/10/2010 11:55'! includes: aRule ^rules includes: aRule! ! !TLWritingStyle methodsFor: 'initialization' stamp: 'JorgeRessia 5/10/2010 11:58'! initializeNamed: aString formedBy: aCollection name := aString. rules := aCollection asOrderedCollection! ! !TLWritingStyle methodsFor: 'accessing' stamp: 'JorgeRessia 5/10/2010 11:54'! name ^ name! ! !TLWritingStyle methodsFor: 'accessing' stamp: 'JorgeRessia 5/10/2010 11:59'! rules ^ OrderedCollection withAll: rules! ! TLWordClassifier initialize!