SystemOrganization addCategory: #'TextLint-Model'! SystemOrganization addCategory: #'TextLint-Model-Parser'! SystemOrganization addCategory: #'TextLint-Model-Rules'! SystemOrganization addCategory: #'TextLint-Model-Runner'! SystemOrganization addCategory: #'TextLint-Model-Dictionary'! SystemOrganization addCategory: #'TextLint-Model-Rules-Tests'! PPCompositeParser subclass: #TLDictionaryParser instanceVariableNames: 'dictionary wordDefinition wordDefinitonTerminator type noun verb adverb adjective article pronoun preposition conjunction interjection undefined typeDefinition' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:40'! adjective ^ 'Adjective' asParser ==> [ :token | TLAdjective new ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:40'! adverb ^ 'Adverb' asParser ==> [ :token | TLAdverb new ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:40'! article ^ 'Article' asParser ==> [ :token | TLArticle new ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:41'! conjunction ^ 'Conjunction' asParser ==> [ :token | TLConjunction new ]! ! !TLDictionaryParser methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/27/2011 13:11'! dictionary ^ wordDefinition plus ==> [ :nodes | TLDictionary withAll: nodes ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:41'! interjection ^ 'Interjection' asParser ==> [ :token | TLInterjection new ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:46'! noun ^ 'Noun' asParser ==> [ :nodes | TLNoun new ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:41'! preposition ^ 'Preposition' asParser ==> [ :token | TLPreposition new ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:41'! pronoun ^ 'Pronoun' asParser ==> [ :token | TLPronoun new ]! ! !TLDictionaryParser methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/27/2011 12:44'! start ^ dictionary end! ! !TLDictionaryParser methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/27/2011 14:21'! type ^ noun / verb / adverb / adjective / article / pronoun / preposition / conjunction / interjection / undefined ! ! !TLDictionaryParser methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/27/2011 14:42'! typeDefinition ^ ( $[ asParser, type , $] asParser ) ! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:41'! undefined ^'' asParser ==> [ :token | TLUndefinedWordType new ]! ! !TLDictionaryParser methodsFor: 'types' stamp: 'JorgeRessia 4/27/2011 14:41'! verb ^ 'Verb' asParser ==> [ :token | TLVerb new ]! ! !TLDictionaryParser methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/28/2011 20:06'! wordDefinition ^ ( ( #word asParser plus flatten, Character tab asParser, $[ asParser negate star flatten, typeDefinition ) , wordDefinitonTerminator optional ) ==> [ :nodes | TLWordDefinition named: ( String withAll: nodes first ) typed: nodes fourth second]! ! !TLDictionaryParser methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/28/2011 20:10'! wordDefinitonTerminator ^ PPPredicateObjectParser on: [ :token | String crlf includes: token ] message: 'End of sentence expected'! ! 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: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLPatternTokenizer methodsFor: 'accessing' stamp: 'JorgeRessia 11/3/2010 23:02'! elementList ^ super elementList foldLeft: [ :a :b | a , b ]! ! !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: #TLDictionary instanceVariableNames: 'wordDefinitions wordsTypes undefinedWordType' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLDictionary class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/27/2011 13:08'! withAll: aCollection ^ self new initializeWithAll: aCollection! ! !TLDictionary methodsFor: 'initialization' stamp: 'JorgeRessia 4/30/2011 18:12'! indexTypesByWords wordDefinitions do: [ :eachDefinition | | types | types := wordsTypes at: eachDefinition word ifAbsentPut: ( OrderedCollection new ). types add: eachDefinition type ]! ! !TLDictionary methodsFor: 'initialization' stamp: 'JorgeRessia 4/30/2011 17:54'! initialize wordsTypes := Dictionary new.! ! !TLDictionary methodsFor: 'initialization' stamp: 'JorgeRessia 4/30/2011 17:59'! initializeWithAll: aCollection wordDefinitions := aCollection. self indexTypesByWords! ! !TLDictionary methodsFor: 'accessing' stamp: 'JorgeRessia 4/30/2011 18:43'! typeFor: aString wordsTypes at: aString ifPresent: [ :types | ( types size = 1) ifTrue: [ ^ types first ] ]. ^ self undefinedWordType! ! !TLDictionary methodsFor: 'accessing' stamp: 'JorgeRessia 4/30/2011 17:55'! undefinedWordType ^ undefinedWordType ifNil: [ undefinedWordType := TLUndefinedWordType new]! ! !TLDictionary methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 13:10'! wordDefinitions ^ wordDefinitions! ! Object subclass: #TLDictionaryBuilder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLDictionaryBuilder methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/28/2011 19:09'! buildDictionaryFrom: aPath | dictionary fileContents | fileContents := MultiByteFileStream readOnlyFileNamed: aPath do: [ :stream | stream contents ]. dictionary := self parse: fileContents. ^ dictionary.! ! !TLDictionaryBuilder methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/28/2011 19:09'! parse: aString | dictionary | dictionary := TLDictionaryParser parse: aString onError: [ :err | self error: err printString ]. ^ dictionary ! ! 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: 'testing' stamp: 'lr 4/6/2010 20:44'! isWord ^ true! ! !TLWord methodsFor: 'accessing' stamp: 'JorgeRessia 4/30/2011 20:13'! type ^ type! ! !TLWord methodsFor: 'accessing' stamp: 'JorgeRessia 4/30/2011 20:13'! type: anObject type := anObject! ! 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: 'JorgeRessia 9/23/2010 23:34'! 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: #TLExcessOfAdjectivesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLExcessOfAdjectivesRule methodsFor: 'running' 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.'! ! !TLExcessOfAdjectivesRule methodsFor: 'running' stamp: 'JorgeRessia 4/30/2011 20:39'! runOnSentence: aSentence | results phrases| results := OrderedCollection new. phrases := aSentence allPhrasesOfSize: 2. phrases do: [ :eachPhrase | ( eachPhrase words first type isAdjective and: [ eachPhrase words second type isAdjective ] ) ifTrue: [ results add: ( TLRuleFailure on: self at: eachPhrase ) ] ]. ^results ! ! 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: 'JorgeRessia 5/4/2011 13:08'! 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'! matchingString ^ 'in regards to'! ! !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: #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: 'JorgeRessia 5/4/2011 10:29'! longRationale ^ 'Make definite assertions. Avoid tame, colorless, hesitating, non-committal language. Use the word not as a means of denial or in antithesis, never as a means of evasion. He was not very often on time. -> He usually came late. not honest -> dishonest.'! ! !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 subclass: #TLPhrasePatternRule instanceVariableNames: 'pattern name rationale' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLPhrasePatternRule class methodsFor: 'accessing' stamp: 'JorgeRessia 11/4/2010 10:23'! allRules ^ #()! ! !TLPhrasePatternRule class methodsFor: 'instance creation' stamp: 'JorgeRessia 11/3/2010 22:13'! named: aName rationale: aRationale matching: aString ^ self new initializeNamed: aName rationale: aRationale matching: aString ! ! !TLPhrasePatternRule methodsFor: 'initialization' stamp: 'JorgeRessia 11/3/2010 23:04'! initializeNamed: aName rationale: aRationale matching: aString pattern := ( TLPatternTokenizer parse: aString ) flatten. name := aName. rationale := aRationale! ! !TLPhrasePatternRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/3/2010 22:15'! name ^ name! ! !TLPhrasePatternRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/3/2010 22:03'! pattern ^ pattern! ! !TLPhrasePatternRule methodsFor: 'accessing' stamp: 'JorgeRessia 11/3/2010 22:15'! rationale ^ rationale! ! !TLPhrasePatternRule methodsFor: 'running' stamp: 'JorgeRessia 11/3/2010 23:04'! runOnSentence: aSentence ^ (self pattern matchesIn: aSentence children) collect: [ :each | TLRuleFailure on: self at: (TLPhrase withAll: each) ]! ! !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 6/12/2010 17:12'! runOnParagraph: aParagraph | results wordsCounter value failingWords| results := OrderedCollection new. 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 wordRepetitionLimit) ifTrue: [failingWords add: aKey]]. aParagraph words do: [ :eachWord | (failingWords includes: eachWord text) ifTrue: [results add: eachWord]]. ^results ! ! !TLWordRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 10:53'! wordRepetitionLimit ^2! ! Object subclass: #TLWordDefinition instanceVariableNames: 'word type name' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLWordDefinition class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/27/2011 13:05'! named: aString typed: aWordType ^ self new initializeNamed: aString typed: aWordType ! ! !TLWordDefinition methodsFor: 'initialization' stamp: 'JorgeRessia 4/27/2011 13:06'! initializeNamed: aString typed: aWordType word := aString. type := aWordType ! ! !TLWordDefinition methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 13:11'! type ^ type! ! !TLWordDefinition methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 13:11'! word ^ word! ! Object subclass: #TLWordType instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! TLWordType subclass: #TLAdjective instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLAdjective class methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 14:52'! typeName ^ 'Adjective'! ! !TLAdjective methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:35'! isAdjective ^ true! ! TLWordType subclass: #TLAdverb instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLAdverb class methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 14:53'! typeName ^ 'Adverb'! ! !TLAdverb methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:35'! isAdverb ^ true! ! TLWordType subclass: #TLArticle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLArticle class methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 14:53'! typeName ^ 'Article'! ! !TLArticle methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:35'! isArticle ^ true! ! TLWordType subclass: #TLConjunction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLConjunction class methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 14:53'! typeName ^ 'Conjunction'! ! !TLConjunction methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:35'! isConjunction ^ true! ! TLWordType subclass: #TLInterjection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLInterjection class methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/27/2011 14:53'! typeName ^ 'Interjection'! ! !TLInterjection methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:36'! isInterjection ^ true! ! TLWordType subclass: #TLNoun instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLNoun class methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/27/2011 14:53'! typeName ^ 'Noun'! ! !TLNoun methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:32'! isNoun ^ true! ! TLWordType subclass: #TLPreposition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLPreposition class methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 14:54'! typeName ^ 'Preposition'! ! !TLPreposition methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:39'! isPreposition ^ true! ! TLWordType subclass: #TLPronoun instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLPronoun class methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 14:54'! typeName ^ 'Pronoun'! ! !TLPronoun methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:36'! isPronoun ^ true! ! TLWordType subclass: #TLUndefinedWordType instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLUndefinedWordType class methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 14:54'! typeName ^ 'Undefined'! ! !TLUndefinedWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:36'! isUndefined ^ true! ! TLWordType subclass: #TLVerb instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Dictionary'! !TLVerb class methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/27/2011 14:54'! typeName ^ 'Verb'! ! !TLVerb methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:33'! isVerb ^ true! ! !TLWordType class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/27/2011 14:49'! named: aString ^ self basicNew initializeNamed: aString! ! !TLWordType class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/27/2011 14:55'! new ^ self named: self typeName! ! !TLWordType methodsFor: 'initialization' stamp: 'JorgeRessia 4/27/2011 13:02'! initializeNamed: aString name := aString! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:39'! isAdjective ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:37'! isAdverb ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:37'! isArticle ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:38'! isConjunction ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:38'! isInterjection ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:37'! isNoun ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:38'! isPreposition ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:37'! isPronoun ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:38'! isUndefined ^ false! ! !TLWordType methodsFor: 'testing' stamp: 'JorgeRessia 4/27/2011 13:37'! isVerb ^ false! ! !TLWordType methodsFor: 'accessing' stamp: 'JorgeRessia 4/27/2011 13:14'! name ^ name! ! 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! !