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 markup word whitespace punctuation' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! TLTextTokenizer subclass: #TLHtmlTokenizer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLHtmlTokenizer methodsFor: 'tokens' stamp: 'lr 5/27/2010 16:41'! markup ^ (($< asParser , $> asParser negate plus , $> asParser) / ($& asParser , $; asParser negate plus , $; asParser)) token ==> [ :token | TLMarkup with: token ]! ! TLTextTokenizer subclass: #TLLatexTokenizer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! !TLLatexTokenizer methodsFor: 'tokens' stamp: 'lr 5/27/2010 16:54'! markup ^ ((PPPredicateParser anyOf: '{}[]`') / ($\ asParser , #word asParser plus) / ($% asParser , #newline asParser negate star)) token ==> [ :token | TLMarkup with: token ]! ! !TLTextTokenizer methodsFor: 'grammar' stamp: 'lr 5/27/2010 16:26'! element ^ markup / 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: 'lr 5/27/2010 16:27'! markup ^ PPFailingParser message: 'Markup expected'! ! !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 5/10/2010 09:32'! consumeFrom: aTLIndexedElement (aTLIndexedElement current text = element text) ifFalse: [ ^false ]. [(aTLIndexedElement current text = element text) and: [aTLIndexedElement isAtTheEnd not]] whileTrue: [ aTLIndexedElement next ]. ^true ! ! !TLAnyNumberOfOcurrenciesPattern methodsFor: 'initialization' stamp: 'JorgeRessia 4/12/2010 20:55'! initializeOf: anElement element := anElement. ! ! !TLAnyNumberOfOcurrenciesPattern methodsFor: 'initialization' stamp: 'FabrizioPerin 5/14/2010 11:04'! name ^'Any Number Of Occurencies Pattern'! ! 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. ! ! !TLAnyOfSetPattern methodsFor: 'comparing' stamp: 'FabrizioPerin 5/14/2010 11:04'! name ^'Any Of Set Pattern'! ! Object subclass: #TLAnyWordPattern instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAnyWordPattern methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 15:59'! consumeFrom: aTLIndexedElement aTLIndexedElement next . ^true! ! !TLAnyWordPattern methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 15:59'! matches: aString ^true! ! !TLAnyWordPattern methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 15:59'! name ^'Any word pattern'! ! 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: 'lr 5/26/2010 15:10'! intializeOn: aString text := aString! ! !TLCaseInsensitiveWordPattern methodsFor: 'private' stamp: 'lr 5/26/2010 15:15'! matches: aString ^ text sameAs: aString! ! !TLCaseInsensitiveWordPattern methodsFor: 'private' stamp: 'FabrizioPerin 5/14/2010 11:04'! name ^'Case Insensitive Word Pattern rule'! ! !TLCaseInsensitiveWordPattern methodsFor: 'private' stamp: 'JorgeRessia 4/13/2010 09:52'! text ^self! ! Object subclass: #TLConditionalWordPattern instanceVariableNames: 'textPattern' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLConditionalWordPattern class methodsFor: 'instance creation' stamp: 'JorgeRessia 5/26/2010 16:39'! with: aPattern ^self new initializeWith: aPattern! ! !TLConditionalWordPattern methodsFor: 'testing' stamp: 'JorgeRessia 5/26/2010 16:58'! consumeFrom: aTLIndexedElement ( aTLIndexedElement current text matchesRegex: textPattern) ifTrue: [aTLIndexedElement next . ^true] ifFalse: [ ^false ]. ! ! !TLConditionalWordPattern methodsFor: 'initialization' stamp: 'JorgeRessia 5/26/2010 16:40'! initializeWith: aString textPattern := aString! ! !TLConditionalWordPattern methodsFor: 'testing' stamp: 'JorgeRessia 5/26/2010 16:35'! name ^'Conditional word pattern'! ! 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: '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 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: '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 phrasesCache' 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: '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 5/26/2010 13:44'! initializeWithAll: aCollection syntacticElements := aCollection. phrasesCache := Dictionary new! ! !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: #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: '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: '' 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! ! Object subclass: #TLIndexedElement instanceVariableNames: 'index element isAtTheEnd' 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 5/9/2010 19:22'! initializeOf: aTLElement element := aTLElement. index := 1. isAtTheEnd := false! ! !TLIndexedElement methodsFor: 'accessing' stamp: 'JorgeRessia 5/10/2010 09:22'! isAtTheEnd [ element children at: (index + 1) ] on: Error do: [ ^true ]. ^false! ! !TLIndexedElement methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 10:52'! name ^'Indexed Element Rule'! ! !TLIndexedElement methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 19:22'! next [ ^element children at: (index := index + 1) ] on: Error do: [ isAtTheEnd := true. ^nil ]! ! Object subclass: #TLMassPaperAnalysis instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Runner'! !TLMassPaperAnalysis methodsFor: 'private' stamp: 'JorgeRessia 5/27/2010 13:11'! analyze |paperNames allFailures aChecker fileContents results file| aChecker := TLTextLintChecker new. TLWritingStyle computerSciencePaperStyle rules do: [:rule | aChecker addRule: rule ]. allFailures := Dictionary new. paperNames := (FileDirectory on: '/Users/ressia/temp/Papers') 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. 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: eachFailure rule class name; nextPutAll: ' '; nextPutAll: eachFailure element text; nextPutAll: ' ']]. ! ! 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: #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 5/26/2010 15:59'! anyword patterns add: (TLAnyWordPattern new ) ! ! !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: 'FabrizioPerin 5/14/2010 11:02'! name ^'Rule Pattern'! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 4/12/2010 21:30'! with: aTLElement patterns add: (TLSingleOcurrencyPattern of: aTLElement ) ! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 5/26/2010 17:05'! wordMatching: aPattern patterns add: ((TLConditionalWordPattern with: aPattern) ) ! ! 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. ! ! !TLSingleOcurrencyPattern methodsFor: 'initialization' stamp: 'FabrizioPerin 5/14/2010 10:59'! name ^'Single Occurrency Pattern'! ! 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: 'lr 5/27/2010 16:49'! check: aString ^ self check: aString tokenizer: ( (#('\documentclass' '\usepackage' '\section' '\begin{') anySatisfy: [ :each | aString includesSubString: each ]) ifTrue: [ TLLatexTokenizer ] ifFalse: [ (#(' 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: #TLNoSpacesBeforePunctuationMarkRule instanceVariableNames: 'wordsBeforeCommaExceptions' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/28/2010 09:24'! name ^'No Whitespace before punctuation mark.'! ! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/28/2010 09:24'! rationale ^'There should be no whitespaces before any punctuation mark.'! ! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'running' stamp: 'JorgeRessia 5/28/2010 09:23'! runOn: aDocument ^aDocument sentences gather: [ :eachSentence | self runOnSentence: eachSentence ]. ! ! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'running' stamp: 'JorgeRessia 5/28/2010 09:31'! runOnSentence: aSentence | results numberOfCommas children commaIndex wordsBeforeComma wordsAfterComma | results := OrderedCollection new. children := aSentence children. children do: [:each | ((each isPunctuation) and: [each text = ',']) ifTrue: [ ((children at: (children indexOf: each ) - 1) text = ',') ifTrue: [results add: (TLRuleFailure on: self at: each)]] ]. ^results ! ! TLTextLintRule subclass: #TLPhraseRule instanceVariableNames: 'pattern' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! TLPhraseRule subclass: #TLALotRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLALotRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:14'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'a'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'lot'). ^aRulePattern! ! !TLALotRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:03'! name ^'A Lot rule'! ! !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: #TLARule instanceVariableNames: 'specialCases' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLARule methodsFor: 'initialization' stamp: 'JorgeRessia 5/27/2010 13:25'! initialize super initialize. self initializeSpecialCases ! ! !TLARule methodsFor: 'initialization' stamp: 'JorgeRessia 5/27/2010 13:30'! initializeSpecialCases specialCases := OrderedCollection new add: 'union'; add: 'united'; add: 'unified'; add: 'unifying'; add: 'US'; add: 'one'; add: 'unit'; add: 'user'; add: 'usage'; add: 'universal'; add: 'unique'; add: 'unit'; add: 'useful'; add: 'uniform'; yourself.! ! !TLARule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 17:13'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'a'); anyNumberOf: (TLWhitespace new); wordMatching: '([aeiou]|[AEIOU]).*'. ^aRulePattern! ! !TLARule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 16:30'! name ^'A rule'! ! !TLARule methodsFor: 'accessing' stamp: 'JorgeRessia 5/27/2010 21:22'! rationale ^ 'After a only words beginning without a vowel are allowed. The next words are exceptions taken into account: ' , (self specialCases inject: ' ' into: [:sum :each | sum, ', ', each ]).! ! !TLARule methodsFor: 'running' stamp: 'JorgeRessia 5/27/2010 15:59'! runOnSentence: aSentence ^(super runOnSentence: aSentence) reject: [:eachFailure | self specialCases anySatisfy: [:eachWord | eachFailure element words second text sameAs: eachWord] ]! ! !TLARule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 16:30'! sizeInWords ^2! ! !TLARule methodsFor: 'accessing' stamp: 'JorgeRessia 5/27/2010 13:25'! specialCases ^specialCases ! ! TLPhraseRule subclass: #TLAllowToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAllowToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:06'! matchingPattern | aRulePattern aWord anotherWord | aRulePattern := TLRulePattern new. aWord := TLCaseInsensitiveWordPattern on: 'Allow'. anotherWord := TLCaseInsensitiveWordPattern on: 'Allows'. aRulePattern anyOf: (OrderedCollection with: aWord with: anotherWord); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'to'). ^aRulePattern! ! !TLAllowToRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:02'! name ^'Allow To rule'! ! !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: #TLAnRule instanceVariableNames: 'specialCases' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAnRule methodsFor: 'initialization' stamp: 'JorgeRessia 5/27/2010 13:27'! initialize super initialize. self initializeSpecialCases ! ! !TLAnRule methodsFor: 'initialization' stamp: 'JorgeRessia 5/27/2010 13:26'! initializeSpecialCases specialCases := OrderedCollection new add: 'honorable'; add: 'honest'; add: 'hour'; add: 'xml'; add: 'hybrid'; add: 'html'; add: 'http'; yourself.! ! !TLAnRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 20:37'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'an'); anyNumberOf: (TLWhitespace new); wordMatching: '([^aeiouAEIOU]).*'. ^aRulePattern! ! !TLAnRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 20:37'! name ^'An rule'! ! !TLAnRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/27/2010 21:23'! rationale ^ 'After an only words beginning with a vowel are allowed. The next words are exceptions taken into account: ' , (self specialCases inject: ' ' into: [:sum :each | sum, ', ', each ]).! ! !TLAnRule methodsFor: 'running' stamp: 'JorgeRessia 5/27/2010 16:03'! runOnSentence: aSentence ^(super runOnSentence: aSentence) reject: [:eachFailure | self specialCases anySatisfy: [:eachWord | eachFailure element words second text sameAs: eachWord] ]! ! !TLAnRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 20:36'! sizeInWords ^2! ! !TLAnRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/27/2010 13:27'! specialCases ^specialCases ! ! TLPhraseRule subclass: #TLAsToWhetherRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:15'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'as'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'to'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'whether'). ^aRulePattern! ! !TLAsToWhetherRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:05'! name ^'As To Wether rule'! ! !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 subclass: #TLHelpToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHelpToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:15'! matchingPattern | aRulePattern aWord anotherWord | aRulePattern := TLRulePattern new. aWord := TLCaseInsensitiveWordPattern on: 'Help'. anotherWord := TLCaseInsensitiveWordPattern on: 'Helps'. aRulePattern anyOf: (OrderedCollection with: aWord with: anotherWord); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'to'). ^aRulePattern! ! !TLHelpToRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:05'! name ^'Help To rule'! ! !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: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:29'! sizeInWords ^2! ! TLPhraseRule subclass: #TLInOrderToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInOrderToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/13/2010 19:55'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'in'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'order'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'to'). ^aRulePattern! ! !TLInOrderToRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:06'! name ^'In Order To rule'! ! !TLInOrderToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/13/2010 19:55'! rationale ^ 'This expression is pure clutter and most of the time can be avoided.'! ! !TLInOrderToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/13/2010 19:55'! sizeInWords ^3! ! TLPhraseRule subclass: #TLNoCommaBeforeThatRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoCommaBeforeThatRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 15:44'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern anyword; anyNumberOf: (TLPunctuationMark with: (PPToken on: ',')); with: (TLCaseInsensitiveWordPattern on: 'that'). ^aRulePattern! ! !TLNoCommaBeforeThatRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 15:08'! name ^'No Comma before that rule'! ! !TLNoCommaBeforeThatRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 15:09'! rationale ^ 'In German, you must put a comma before "dass". Not in English. Wrong: "The log message confirms, that comparing pthread with == is not portable." Right: "The log message confirms that comparing pthread with == is not portable." Basically, use commas in English only if leaving them out would lead to ambiguity.'! ! !TLNoCommaBeforeThatRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/26/2010 15:22'! sizeInWords ^2! ! TLPhraseRule subclass: #TLOneOfTheMostRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLOneOfTheMostRule methodsFor: 'running' stamp: 'JorgeRessia 5/26/2010 13:11'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'one'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'of'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'the'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'most'). ^aRulePattern! ! !TLOneOfTheMostRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:07'! name ^'One Of The Most rule'! ! !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: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:30'! sizeInWords ^4! ! !TLPhraseRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 12:11'! matchingPattern ^self subclassResponsibility ! ! !TLPhraseRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:03'! name ^'Phrase rule'! ! !TLPhraseRule methodsFor: 'accessing' stamp: 'lr 5/26/2010 15:22'! pattern ^ pattern ifNil: [ pattern := self matchingPattern ]! ! !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 5/26/2010 11:23'! runOn: aDocument ^ aDocument sentences gather: [ :eachSentence | self runOnSentence: eachSentence ]! ! !TLPhraseRule methodsFor: 'running' stamp: 'lr 5/26/2010 15:22'! runOnSentence: aSentence | results | results := OrderedCollection new. (aSentence allPhrasesOfSize: self sizeInWords) do: [:eachPhrase | (self pattern matches: eachPhrase) ifTrue: [results add: (TLRuleFailure on: self at: eachPhrase)] ]. ^results ! ! !TLPhraseRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 10:55'! sizeInWords ^self subclassResponsibility ! ! TLPhraseRule subclass: #TLRegardedAsBeingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLRegardedAsBeingRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:15'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'regarded'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'as'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'being'). ^aRulePattern! ! !TLRegardedAsBeingRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:07'! name ^'Regarded As Being rule'! ! !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: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:30'! sizeInWords ^3! ! TLPhraseRule subclass: #TLRequireToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLRequireToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:15'! matchingPattern | aRulePattern aWord anotherWord | aRulePattern := TLRulePattern new. aWord := TLCaseInsensitiveWordPattern on: 'require'. anotherWord := TLCaseInsensitiveWordPattern on: 'requires'. aRulePattern anyOf: (OrderedCollection with: aWord with: anotherWord); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'to'). ^aRulePattern! ! !TLRequireToRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:07'! name ^'Require To rule'! ! !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: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:30'! sizeInWords ^2! ! TLPhraseRule subclass: #TLTheFactIsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheFactIsRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:15'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'the'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'fact'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'is'). ^aRulePattern! ! !TLTheFactIsRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:08'! name ^'The Fact Is rule'! ! !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: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:31'! sizeInWords ^3! ! TLPhraseRule subclass: #TLTheFactThatRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheFactThatRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:14'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'the'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'fact'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'that'). ^aRulePattern! ! !TLTheFactThatRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:08'! name ^'The Fact That rule'! ! !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: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:31'! sizeInWords ^3! ! TLPhraseRule subclass: #TLTheTruthIsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTheTruthIsRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/9/2010 11:13'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'the'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'truth'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'is'). ^aRulePattern! ! !TLTheTruthIsRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:08'! name ^'The Truth Is rule'! ! !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: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:31'! sizeInWords ^3! ! TLTextLintRule subclass: #TLSomehowRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSomehowRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 12:03'! matchingPattern ^TLRulePattern new with: (TLCaseInsensitiveWordPattern on: 'somehow'). ! ! !TLSomehowRule methodsFor: 'running' stamp: 'FabrizioPerin 5/14/2010 11:09'! name ^'Somehow rule'! ! !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 5/26/2010 15:37'! runOn: aDocument ^aDocument words gather: [ :eachWord | self runOnWord: eachWord ]. ! ! !TLSomehowRule methodsFor: 'running' stamp: 'lr 5/26/2010 15:13'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'somehow' ) ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! !TLSomehowRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:30'! sizeInWords ^1! ! TLTextLintRule subclass: #TLSpellCheckerRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSpellCheckerRule methodsFor: 'running' stamp: 'FabrizioPerin 5/14/2010 11:09'! name ^'Spell Checker rule'! ! !TLSpellCheckerRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/5/2010 16:23'! rationale ^ 'There is a spell check mistake'! ! !TLSpellCheckerRule methodsFor: 'running' stamp: 'JorgeRessia 5/5/2010 16:32'! runOn: aDocument | aSpellChecker | aSpellChecker := RBSpellChecker createInstance. ^aDocument words reject: [ :eachWord | ( aSpellChecker check: eachWord text) isEmpty ]. ! ! TLTextLintRule subclass: #TLStuffRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLStuffRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:09'! name ^'Stuff rule'! ! !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 5/26/2010 15:36'! runOn: aDocument ^aDocument words gather: [ :eachWord | self runOnWord: eachWord ]. ! ! !TLStuffRule methodsFor: 'running' stamp: 'lr 5/26/2010 15:14'! runOnWord: aWord | results | results := OrderedCollection new. ( (aWord text sameAs: 'stuff') or: [ aWord text sameAs: 'stuffs' ]) ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! !TLStuffRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/13/2010 11:30'! sizeInWords ^1! ! !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 5/26/2010 11:20'! runOn: aDocument ^self subclassResponsibility! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 5/26/2010 11:20'! runOnDocument: aDocument ^#()! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 5/26/2010 10:25'! runOnParagraph: aParagraph ^#()! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 5/26/2010 10:25'! runOnSentence: aSentence ^#()! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 5/26/2010 10:26'! runOnWord: aWord ^#()! ! TLTextLintRule subclass: #TLThingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLThingRule methodsFor: 'running' stamp: 'FabrizioPerin 5/14/2010 11:09'! name ^'Thing rule'! ! !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 5/26/2010 12:18'! runOn: aDocument ^aDocument words gather: [ :eachWord | self runOnWord: eachWord ]. ! ! !TLThingRule methodsFor: 'running' stamp: 'lr 5/26/2010 15:14'! runOnWord: aWord | results | results := OrderedCollection new. ((aWord text sameAs: 'thing') or: [ aWord text sameAs: 'things' ] ) ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLWordRepetitionInParagraphRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLWordRepetitionInParagraphRule methodsFor: 'accessing' stamp: 'FabrizioPerin 5/14/2010 11:10'! name ^'Word Repetition In Paragraph rule'! ! !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 5/26/2010 15:36'! runOn: aDocument ^aDocument paragraphs gather: [ :eachParagraph | self runOnParagraph: eachParagraph ]. ! ! !TLWordRepetitionInParagraphRule methodsFor: 'running' stamp: 'JorgeRessia 5/26/2010 10:40'! runOnParagraph: aParagraph | words 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: #TLWritingStyle instanceVariableNames: 'name rules' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLWritingStyle class methodsFor: 'accessing' stamp: 'JorgeRessia 5/10/2010 14:52'! computerSciencePaperStyle |rules| rules := OrderedCollection new. TLTextLintRule allSubclassesDo: [:class | class allSubclasses isEmpty ifTrue: [rules add: class new]].. rules := rules reject: [:each | each class name = #TLWordRepetitionInParagraphRule]. rules := rules reject: [:each | each class name = #TLSpellCheckerRule]. ^TLWritingStyle named: 'Computer Science Paper Style' formedBy: rules.! ! !TLWritingStyle class methodsFor: 'instance creation' stamp: 'JorgeRessia 5/10/2010 11:52'! named: aString formedBy: anArray ^self new initializeNamed: aString formedBy: anArray ! ! !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! !