SystemOrganization addCategory: #'TextLint-Model'! SystemOrganization addCategory: #'TextLint-Model-Parser'! SystemOrganization addCategory: #'TextLint-Model-Runner'! SystemOrganization addCategory: #'TextLint-Model-Rules'! PPCompositeParser subclass: #TLTextPhraser instanceVariableNames: 'document documentTerminator paragraph paragraphTerminator sentence sentenceTerminator' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLTextPhraser methodsFor: 'grammar' stamp: 'lr 4/6/2010 22:06'! document ^ (paragraph starLazy: documentTerminator) , (documentTerminator optional) ==> [ :nodes | TLDocument withAll: nodes first ]! ! !TLTextPhraser methodsFor: 'grammar' stamp: 'lr 4/6/2010 22:03'! documentTerminator ^ PPPredicateParser on: [ :token | token isEndOfDocument ] message: 'End of document expected'! ! !TLTextPhraser methodsFor: 'grammar' stamp: 'lr 4/6/2010 22:05'! paragraph ^ (sentence starLazy: paragraphTerminator / documentTerminator) , (paragraphTerminator optional) ==> [ :nodes | TLParagraph withAll: (nodes last isNil ifFalse: [ nodes first copyWith: nodes last ] ifTrue: [ nodes first ]) ]! ! !TLTextPhraser methodsFor: 'grammar' stamp: 'lr 4/6/2010 21:45'! paragraphTerminator ^ PPPredicateParser on: [ :token | token isWhitespace and: [ token isEndOfParagraph ] ] message: 'End of paragraph expected'! ! !TLTextPhraser methodsFor: 'grammar' stamp: 'lr 4/6/2010 22:04'! sentence ^ (#any asParser starLazy: sentenceTerminator / paragraphTerminator / documentTerminator) , (sentenceTerminator optional) ==> [ :nodes | TLSentence withAll: (nodes last isNil ifFalse: [ nodes first copyWith: nodes last ] ifTrue: [ nodes first ]) ]! ! !TLTextPhraser methodsFor: 'grammar' stamp: 'lr 4/6/2010 21:27'! sentenceTerminator ^ PPPredicateParser on: [ :token | token isPunctuation and: [ token isEndOfSentence ] ] message: 'End of sentence expected'! ! !TLTextPhraser methodsFor: 'accessing' stamp: 'lr 4/6/2010 21:43'! start ^ document end! ! PPCompositeParser subclass: #TLTextTokenizer instanceVariableNames: 'elementList element word whitespace punctuation' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLTextTokenizer methodsFor: 'grammar' stamp: 'lr 4/6/2010 20:20'! element ^ word / whitespace / punctuation! ! !TLTextTokenizer methodsFor: 'grammar' stamp: 'JorgeRessia 4/7/2010 15:06'! elementList ^ element star ==> [ :nodes | nodes copyWith: (TLTerminatorMark with: '') ]! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'JorgeRessia 4/7/2010 15:05'! punctuation ^ #any asParser token ==> [ :node | TLPunctuationMark with: node ]! ! !TLTextTokenizer methodsFor: 'accessing' stamp: 'lr 4/6/2010 20:21'! start ^ elementList end! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'JorgeRessia 4/7/2010 15:05'! whitespace ^ #space asParser plus token ==> [ :node | TLWhitespace with: node ]! ! !TLTextTokenizer methodsFor: 'tokens' stamp: 'JorgeRessia 4/7/2010 15:04'! word ^ #word asParser plus token ==> [ :node | TLWord with: node ]! ! Object subclass: #TLAnyNumberOfOcurrenciesPattern instanceVariableNames: 'element' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAnyNumberOfOcurrenciesPattern class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/12/2010 19:56'! of: anElement ^self new initializeOf: anElement! ! !TLAnyNumberOfOcurrenciesPattern methodsFor: 'matching' stamp: 'JorgeRessia 4/12/2010 20:40'! consumeFrom: aTLIndexedElement (aTLIndexedElement current text = element text) ifFalse: [ ^false ]. [aTLIndexedElement next text = element text] whileTrue: [ ]. ^true ! ! !TLAnyNumberOfOcurrenciesPattern methodsFor: 'initialization' stamp: 'JorgeRessia 4/12/2010 20:55'! initializeOf: anElement element := anElement. ! ! Object subclass: #TLAnyOfSetPattern instanceVariableNames: 'elements' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAnyOfSetPattern class methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/12/2010 21:05'! of: elements ^self new initializeOf: elements! ! !TLAnyOfSetPattern methodsFor: 'comparing' stamp: 'JorgeRessia 4/12/2010 21:06'! consumeFrom: aTLIndexedElement (elements anySatisfy: [:eachElement | eachElement text = aTLIndexedElement current text]) ifTrue: [aTLIndexedElement next . ^true] ifFalse: [ ^false ]. ! ! !TLAnyOfSetPattern methodsFor: 'comparing' stamp: 'JorgeRessia 4/12/2010 21:06'! initializeOf: elementsCollection elements := elementsCollection. ! ! Object subclass: #TLCaseInsensitiveWordPattern instanceVariableNames: 'text' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCaseInsensitiveWordPattern class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/13/2010 09:46'! on: aString ^self new intializeOn: aString! ! !TLCaseInsensitiveWordPattern methodsFor: 'private' stamp: 'JorgeRessia 4/13/2010 09:53'! = aString ^self matches: aString! ! !TLCaseInsensitiveWordPattern methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/13/2010 09:48'! intializeOn: aString text := aString translateToLowercase ! ! !TLCaseInsensitiveWordPattern methodsFor: 'private' stamp: 'JorgeRessia 4/13/2010 09:47'! matches: aString ^aString translateToLowercase = text! ! !TLCaseInsensitiveWordPattern methodsFor: 'private' stamp: 'JorgeRessia 4/13/2010 09:52'! text ^self! ! 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: '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: '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: '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: '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 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: '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: '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 4/8/2010 14:56'! words ^ syntacticElements select: [:eachToken | eachToken isWord ]! ! TLElement subclass: #TLSentence instanceVariableNames: 'syntacticElements' 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 4/9/2010 15:45'! allPhrasesOfSize: aSmallInteger | phrases words | 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: [ ^phrases] ]. ^phrases! ! !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 4/8/2010 11:08'! initializeWithAll: aCollection syntacticElements := aCollection! ! !TLSentence methodsFor: 'testing' stamp: 'JorgeRessia 4/7/2010 12:12'! isSentence ^ true! ! !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: #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: '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 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: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLWord methodsFor: 'testing' stamp: 'lr 4/6/2010 20:44'! isWord ^ true! ! Object subclass: #TLIndexedElement instanceVariableNames: 'index element' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLIndexedElement class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/12/2010 20:24'! of: aTLElement ^self new initializeOf: aTLElement! ! !TLIndexedElement methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 20:51'! current ^element children at: index! ! !TLIndexedElement methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 20:27'! element ^element! ! !TLIndexedElement methodsFor: 'initialization' stamp: 'JorgeRessia 4/12/2010 20:52'! initializeOf: aTLElement element := aTLElement. index := 1! ! !TLIndexedElement methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 20:38'! next [ ^element children at: (index := index + 1) ] on: Error do: [ ^nil ]! ! Object subclass: #TLMatchRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! TLMatchRule subclass: #TLALotMatchRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLALotMatchRule methodsFor: 'accessing' stamp: 'lr 4/13/2010 00:03'! matcher ^ ('A' asParser / 'a' asParser) , #space asParser plus , 'lot' asParser! ! !TLALotMatchRule methodsFor: 'accessing' stamp: 'lr 4/12/2010 23:54'! rationale ^ 'Avoid using a lot, it weakens the sentence'! ! !TLMatchRule methodsFor: 'initialization' stamp: 'lr 4/13/2010 00:02'! initialize super initialize. matcher := self matcher token! ! !TLMatchRule methodsFor: 'accessing' stamp: 'lr 4/12/2010 23:51'! matcher self subclassResponsibility! ! !TLMatchRule methodsFor: 'accessing' stamp: 'lr 4/12/2010 23:51'! rationale self subclassResponsibility! ! !TLMatchRule methodsFor: 'running' stamp: 'lr 4/13/2010 00:01'! runOn: aDocument ^ matcher matchesIn: (self sequenceIn: aDocument)! ! !TLMatchRule methodsFor: 'accessing' stamp: 'lr 4/13/2010 00:01'! sequenceIn: aDocument ^ aDocument text! ! 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: '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: #TLRulePattern instanceVariableNames: 'patterns' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 4/12/2010 21:30'! anyNumberOf: aTLElement patterns add: (TLAnyNumberOfOcurrenciesPattern of: aTLElement ) ! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 4/12/2010 21:29'! anyOf: elements patterns add: (TLAnyOfSetPattern of: elements) ! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 4/12/2010 21:28'! initialize patterns := OrderedCollection new.! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 4/12/2010 21:33'! matches: aTLPhrase | anIndexedElement | anIndexedElement := TLIndexedElement of: aTLPhrase. ^patterns allSatisfy: [ :eachPattern | eachPattern consumeFrom: anIndexedElement] ! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 4/12/2010 21:30'! with: aTLElement patterns add: (TLSingleOcurrencyPattern of: aTLElement ) ! ! Object subclass: #TLSingleOcurrencyPattern instanceVariableNames: 'isSatisfied element' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSingleOcurrencyPattern class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/12/2010 19:36'! of: anElement ^self new initializeOf: anElement! ! !TLSingleOcurrencyPattern methodsFor: 'comparing' stamp: 'JorgeRessia 4/13/2010 09:57'! consumeFrom: aTLIndexedElement ( element text = aTLIndexedElement current text) ifTrue: [aTLIndexedElement next . ^true] ifFalse: [ ^false ]. ! ! !TLSingleOcurrencyPattern methodsFor: 'initialization' stamp: 'JorgeRessia 4/12/2010 20:58'! initializeOf: anElement element := anElement. ! ! Object subclass: #TLTextLintChecker instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Runner'! !TLTextLintChecker methodsFor: 'accessing' stamp: 'JorgeRessia 3/31/2010 16:49'! addRule: aRule rules add: aRule! ! !TLTextLintChecker methodsFor: 'public' stamp: 'JorgeRessia 4/8/2010 16:08'! check: aString | aDocument | aDocument := TLTextPhraser parse: (TLTextTokenizer parse: aString). ^self checkDocument: aDocument.! ! !TLTextLintChecker methodsFor: 'mocking' stamp: 'JorgeRessia 4/8/2010 16:08'! checkDocument: aDocument ^ rules gather: [ :rule | (rule runOn: aDocument) collect: [:element | TLRuleFailure on: rule at: element]]! ! !TLTextLintChecker methodsFor: 'initializing' stamp: 'JorgeRessia 3/31/2010 16:50'! initialize rules := OrderedCollection new! ! Object subclass: #TLTextLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! TLTextLintRule subclass: #TLAvoidQualifiersRule instanceVariableNames: 'qualifiers' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAvoidQualifiersRule methodsFor: 'initialization' stamp: 'lr 4/6/2010 22:25'! initialize super initialize. self initializeQualifiers.! ! !TLAvoidQualifiersRule methodsFor: 'initialization' stamp: 'FabrizioPerin 4/11/2010 13:03'! initializeQualifiers qualifiers := OrderedCollection new. qualifiers add: 'rather'; add: 'very'; add: 'pretty'; add: 'little'; add: 'quite'; add: 'really'. ! ! !TLAvoidQualifiersRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:10'! rationale ^ 'Avoid the use of qualifiers. These are the leeches that infest the pond of prose, sucking the blood of words. The constant use of the adjective little (except to indicate size) is particularly debilitating; we should all try to do a little better, we should all be very watchful of this rule, for it is a rather important one, and we are pretty sure to violate it now and then. Rule 8, An approach to Style - The Elements of Style - W. Strunk and E.B. White'! ! !TLAvoidQualifiersRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:39'! runOn: aDocument ^ aDocument words select: [ :each | qualifiers includes: each text translateToLowercase ] ! ! TLTextLintRule subclass: #TLContinuousWordRepetitionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLContinuousWordRepetitionRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:22'! rationale ^ 'Detection of words repetion'! ! !TLContinuousWordRepetitionRule methodsFor: 'running' stamp: 'JorgeRessia 4/8/2010 12:11'! runOn: aDocument | words results | results := OrderedCollection new. aDocument sentences do: [:eachSentence | words := eachSentence words asArray. 2 to: words size do: [:index | ((words at: index) text translateToLowercase = (words at: index - 1) text translateToLowercase) ifTrue: [ results add: (words at: index - 1)] ] ]. ^results ! ! TLTextLintRule subclass: #TLHelpToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHelpToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/4/2010 10:41'! rationale ^ 'Never use the expressions "help/s to". This expression requires a direct object.'! ! !TLHelpToRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:41'! runOn: aDocument ^ aDocument sentences select: [ :each | (each containsPhrase: 'help to') or: [ each containsPhrase: 'helps to' ] ]! ! TLTextLintRule subclass: #TLHoweverRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHoweverRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:13'! rationale ^ 'Avoid starting a sentence with however when the meaning is nevertheless. The word usually serves when not in first possition. Misused words and expressions (page 48) - The Elements of Style - W. Strunk and E.B. White'! ! !TLHoweverRule methodsFor: 'running' stamp: 'JorgeRessia 4/8/2010 12:21'! runOn: aDocument | results sentences | results := OrderedCollection new. sentences := aDocument sentences reject: [ :eachSentence | eachSentence words isEmpty]. sentences do: [:eachSentence | (eachSentence words first text translateToLowercase = 'however') ifTrue: [ results add: eachSentence words first] ]. ^results ! ! TLTextLintRule subclass: #TLOneOfTheMostRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLOneOfTheMostRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:16'! rationale ^ 'Avoid this feeble formula. There is nothing wrong with the grammar the formula is simple threadbare. Misused words and expressions (page 55) - The Elements of Style - W. Strunk and E.B. White'! ! !TLOneOfTheMostRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:42'! runOn: aDocument ^ aDocument sentences select: [ :each | each containsPhrase: 'one of the most' ]! ! TLTextLintRule subclass: #TLPhraseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! TLPhraseRule subclass: #TLALotRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLALotRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:02'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'a'); anyNumberOf: (TLWhitespace with: (PPToken on: ' ')); with: (TLCaseInsensitiveWordPattern on: 'lot'). ^aRulePattern! ! !TLALotRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/6/2010 10:51'! rationale ^ 'Avoid using a lot, it weakens the sentence'! ! !TLALotRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 10:59'! sizeInWords ^2! ! TLPhraseRule subclass: #TLAllowToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAllowToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 10:24'! matchingPattern | aRulePattern aWord anotherWord | aRulePattern := TLRulePattern new. aWord := TLCaseInsensitiveWordPattern on: 'Allow'. anotherWord := TLCaseInsensitiveWordPattern on: 'Allows'. aRulePattern anyOf: (OrderedCollection with: aWord with: anotherWord); anyNumberOf: (TLWhitespace with: (PPToken on: ' ')); with: (TLCaseInsensitiveWordPattern on: 'to'). ^aRulePattern! ! !TLAllowToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/4/2010 10:19'! rationale ^ 'Never use the expressions "allow/s to". This expression requires a direct object.'! ! !TLAllowToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 10:56'! sizeInWords ^2! ! TLPhraseRule subclass: #TLAsToWhetherRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:05'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'as'); anyNumberOf: (TLWhitespace with: (PPToken on: ' ')); with: (TLCaseInsensitiveWordPattern on: 'to'); anyNumberOf: (TLWhitespace with: (PPToken on: ' ')); with: (TLCaseInsensitiveWordPattern on: 'whether'). ^aRulePattern! ! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:01'! rationale ^ 'Words and expressions commonly missused - as to whether -> it is enough with whether'! ! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:04'! sizeInWords ^3! ! !TLPhraseRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 10:57'! rationale ^ 'This rule checks for specific phrases in the whole document.'! ! !TLPhraseRule methodsFor: 'running' stamp: 'JorgeRessia 4/13/2010 10:55'! runOn: aDocument ^ aDocument sentences gather: [ :eachSentence | (eachSentence allPhrasesOfSize: self sizeInWords) select: [ :eachPhrase | self matchingPattern matches: eachPhrase ] ]! ! !TLPhraseRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 10:55'! sizeInWords ^self subclassResponsibility ! ! TLTextLintRule subclass: #TLRegardedAsBeingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLRegardedAsBeingRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:19'! rationale ^ 'Being is not appropriate after regard...as. Misused words and expressions (page 41) - The Elements of Style - W. Strunk and E.B. White'! ! !TLRegardedAsBeingRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:41'! runOn: aDocument ^ aDocument sentences select: [ :each | each containsPhrase: 'regarded as being' ]! ! TLTextLintRule subclass: #TLRequireToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLRequireToRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/4/2010 10:25'! rationale ^ 'Never use the expressions "require/s to". This expression requires a direct object.'! ! !TLRequireToRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:42'! runOn: aDocument ^ aDocument sentences select: [ :each | (each containsPhrase: 'require to') or: [ each containsPhrase: 'requires to' ] ]! ! TLTextLintRule subclass: #TLSomehowRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSomehowRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 15:34'! rationale ^ 'Avoid using the word somehow. Is too general and weakens the sentence'! ! !TLSomehowRule methodsFor: 'running' stamp: 'JorgeRessia 4/12/2010 15:34'! runOn: aDocument ^aDocument words select: [ :eachWord | eachWord text translateToLowercase = 'somehow' ]. ! ! TLTextLintRule subclass: #TLStuffRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLStuffRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/8/2010 14:19'! rationale ^ 'Avoid using the word stuff/s. Is too general and weakens the sentence'! ! !TLStuffRule methodsFor: 'running' stamp: 'JorgeRessia 4/8/2010 15:30'! runOn: aDocument ^aDocument words select: [ :eachWord | (eachWord text translateToLowercase = 'stuff') or: [ eachWord text translateToLowercase = 'stuffs' ] ]. ! ! !TLTextLintRule methodsFor: 'public' stamp: 'JorgeRessia 4/1/2010 12:10'! check: anObject ! ! !TLTextLintRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 17:44'! rationale ^ self subclassResponsibility! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 4/5/2010 10:29'! runOn: aDocument ^self subclassResponsibility! ! TLTextLintRule subclass: #TLTheFactIsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheFactIsRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:30'! rationale ^ 'A bad beginning for a sentence. If you think you are possessed of the truth or fact state it. Principles of composition (page 60) - The Elements of Style - W. Strunk and E.B. White'! ! !TLTheFactIsRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:43'! runOn: aDocument ^ aDocument sentences select: [ :each | each containsPhrase: 'the fact is' ]! ! TLTextLintRule subclass: #TLTheFactThatRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheFactThatRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:21'! rationale ^ 'The fact that is an especially debilitating expression. Principles of composition (page 24) - The Elements of Style - W. Strunk and E.B. White'! ! !TLTheFactThatRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:43'! runOn: aDocument ^ aDocument sentences select: [ :each | each containsPhrase: 'the fact that' ]! ! TLTextLintRule subclass: #TLTheTruthIsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheTruthIsRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 18:30'! rationale ^ 'A bad beginning for a sentence. If you think you are possessed of the truth or fact state it. Principles of composition (page 60) - The Elements of Style - W. Strunk and E.B. White'! ! !TLTheTruthIsRule methodsFor: 'running' stamp: 'lr 4/8/2010 13:43'! runOn: aDocument ^ aDocument sentences select: [ :each | each containsPhrase: 'the truth is' ]! ! TLTextLintRule subclass: #TLThingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLThingRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/8/2010 14:07'! rationale ^ 'Avoid using the word thing/s. Is too general and weakens the sentence'! ! !TLThingRule methodsFor: 'running' stamp: 'JorgeRessia 4/8/2010 15:29'! runOn: aDocument ^aDocument words select: [ :eachWord | (eachWord text translateToLowercase = 'thing') or: [ eachWord text translateToLowercase = 'things' ] ]. ! ! TLTextLintRule subclass: #TLWordRepetitionInParagraphRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLWordRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 10:15'! rationale ^ 'The constant repetition of the same words in a paragraph is weakening'! ! !TLWordRepetitionInParagraphRule methodsFor: 'running' stamp: 'JorgeRessia 4/12/2010 11:13'! runOn: aDocument | words results wordsCounter value failingWords| results := OrderedCollection new. aDocument paragraphs do: [ :eachParagraph | wordsCounter := Dictionary new. failingWords := OrderedCollection new. eachParagraph 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]]. eachParagraph words do: [ :eachWord | (failingWords includes: eachWord text) ifTrue: [results add: eachWord]] ]. ^results ! ! !TLWordRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/12/2010 10:53'! wordRepetitionLimit ^2! !