SystemOrganization addCategory: #'TextLint-Model'! SystemOrganization addCategory: #'TextLint-Model-Parser'! SystemOrganization addCategory: #'TextLint-Model-Rules'! SystemOrganization addCategory: #'TextLint-Model-Runner'! 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: 'JorgeRessia 6/12/2010 12:19'! documentTerminator ^ PPPredicateObjectParser 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: 'JorgeRessia 6/12/2010 12:20'! paragraphTerminator ^ PPPredicateObjectParser 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: 'JorgeRessia 6/12/2010 12:20'! sentenceTerminator ^ PPPredicateObjectParser 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 punctuationGroups' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Parser'! TLTextTokenizer 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 ]! ! TLTextTokenizer 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 5/31/2010 07:39'! ignoredCommands ^ #('newcommand' 'renewcommand' 'newenviornment' 'lstset' 'index' 'verb' 'ct') 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! ! !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: 'lr 5/28/2010 11:59'! punctuation ^ (punctuationGroups / #any asParser) token ==> [ :node | TLPunctuationMark with: node ]! ! !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: '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: #TLAnyNumberOfOccurrencesPattern instanceVariableNames: 'element' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLAnyNumberOfOccurrencesPattern class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/12/2010 19:56'! of: anElement ^self new initializeOf: anElement! ! !TLAnyNumberOfOccurrencesPattern 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 ! ! !TLAnyNumberOfOccurrencesPattern methodsFor: 'initialization' stamp: 'JorgeRessia 4/12/2010 20:55'! initializeOf: anElement element := anElement. ! ! !TLAnyNumberOfOccurrencesPattern 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 exceptions' 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 class methodsFor: 'instance creation' stamp: 'JorgeRessia 9/3/2010 11:54'! with: aPattern excepting: aCollection ^self new initializeWith: aPattern excepting: aCollection! ! !TLConditionalWordPattern methodsFor: 'testing' stamp: 'JorgeRessia 9/3/2010 11:52'! consumeFrom: aTLIndexedElement (( aTLIndexedElement current text matchesRegex: textPattern) and: [ (exceptions includes: aTLIndexedElement current text) not] ) ifTrue: [aTLIndexedElement next . ^true] ifFalse: [ ^false ]. ! ! !TLConditionalWordPattern methodsFor: 'initialization' stamp: 'JorgeRessia 9/3/2010 11:53'! initializeWith: aString textPattern := aString. exceptions := OrderedCollection new! ! !TLConditionalWordPattern methodsFor: 'initialization' stamp: 'JorgeRessia 9/3/2010 11:54'! initializeWith: aString excepting: aCollection textPattern := aString. exceptions := aCollection! ! !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: '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 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: '' 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' 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: 'lr 5/30/2010 19:09'! initializeOf: aTLElement element := aTLElement. index := 1! ! !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: 'lr 5/30/2010 19:09'! next ^ [ element children at: (index := index + 1) ] on: Error do: [ :err | nil ]! ! 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 9/8/2010 11:31'! 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: #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: 'lr 5/30/2010 20:10'! anyNumberOf: aTLElement patterns add: (TLAnyNumberOfOccurrencesPattern 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: 'lr 5/30/2010 20:11'! with: aTLElement patterns add: (TLSingleOccurrencePattern of: aTLElement ) ! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 5/26/2010 17:05'! wordMatching: aPattern patterns add: ((TLConditionalWordPattern with: aPattern) ) ! ! !TLRulePattern methodsFor: 'creation' stamp: 'JorgeRessia 9/3/2010 11:55'! wordMatching: aPattern except: exceptions patterns add: ((TLConditionalWordPattern with: aPattern excepting: exceptions ) ) ! ! Object subclass: #TLSingleOccurrencePattern instanceVariableNames: 'element' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLSingleOccurrencePattern class methodsFor: 'instance creation' stamp: 'JorgeRessia 4/12/2010 19:36'! of: anElement ^self new initializeOf: anElement! ! !TLSingleOccurrencePattern methodsFor: 'comparing' stamp: 'JorgeRessia 4/13/2010 09:57'! consumeFrom: aTLIndexedElement ( element text = aTLIndexedElement current text) ifTrue: [aTLIndexedElement next . ^true] ifFalse: [ ^false ]. ! ! !TLSingleOccurrencePattern methodsFor: 'initialization' stamp: 'JorgeRessia 4/12/2010 20:58'! initializeOf: anElement element := anElement. ! ! !TLSingleOccurrencePattern methodsFor: 'initialization' stamp: 'FabrizioPerin 5/14/2010 10:59'! name ^'Single Occurrency Pattern'! ! 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: '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: [ (#(' Many of the rooms lacked air conditioning. It has rarely been the case that any mistake has been made -> Few mistakes have been made. Misused words and expressions (page 42) - The Elements of Style - W. Strunk and E.B. White'! ! !TLCaseRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 22:28'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLCaseRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 22:32'! runOnWord: aWord | results | results := OrderedCollection new. ((aWord text sameAs: 'case') or: [aWord text sameAs: 'cases']) ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLCertainlyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCertainlyRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid "certainly"'! ! !TLCertainlyRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 22:41'! rationale ^ 'Is a manerism that is used indicriminately by some speakers and writers. Avoid its usage if possible. Misused words and expressions (page 42) - The Elements of Style - W. Strunk and E.B. White'! ! !TLCertainlyRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 22:39'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLCertainlyRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 22:41'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'certainly') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLContinuousWordRepetitionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLContinuousWordRepetitionRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid continuous word repetition'! ! !TLContinuousWordRepetitionRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:20'! rationale ^ 'Detection of words repetition'! ! !TLContinuousWordRepetitionRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 19:05'! runOn: aDocument ^ self runOnSentencesIn: aDocument ! ! !TLContinuousWordRepetitionRule methodsFor: 'running' stamp: 'JorgeRessia 5/27/2010 13:42'! runOnSentence: aSentence | words results | results := OrderedCollection new. words := aSentence words asArray. 2 to: words size do: [:index | ((words at: index) text isAllDigits not and: [(words at: index) text sameAs: (words at: index - 1) text]) ifTrue: [ results add: (TLRuleFailure on: self at: (words at: index - 1))] ]. ^results ! ! TLTextLintRule subclass: #TLCouldRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCouldRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid "could"'! ! !TLCouldRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:21'! rationale ^ 'Avoid using the word "could" because it weakens the sentence'! ! !TLCouldRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 14:41'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLCouldRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 14:42'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'could') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLCurrentlyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCurrentlyRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:01'! name ^ 'Avoid "currently"'! ! !TLCurrentlyRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:22'! 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. We are currently reviewing your application -> We are at this moment reviewing your application. Misused words and expressions (page 44) - The Elements of Style - W. Strunk and E.B. White'! ! !TLCurrentlyRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 22:48'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLCurrentlyRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 22:51'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'currently') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLEnormityRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLEnormityRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:02'! name ^ 'Avoid "enormity"'! ! !TLEnormityRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 23:24'! rationale ^ 'Use only in the sense of monstrous wickedness. Misleading, if not wrong, when used to express bigness. Misused words and expressions (page 45) - The Elements of Style - W. Strunk and E.B. White'! ! !TLEnormityRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 23:22'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLEnormityRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 23:25'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'enormity') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLFactorRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLFactorRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:07'! name ^ 'Avoid "factor"'! ! !TLFactorRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:10'! rationale ^ 'A hackneyed word. The expression can be rephased without it. Her superion training was the great factor in her winning the match -> She won the match by being better trained. Air power is becoming an increasingly important factor in deciding battles -> Air power is playing a larger and larger part in deciding battles. Misused words and expressions (page 46) - The Elements of Style - W. Strunk and E.B. White'! ! !TLFactorRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:06'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLFactorRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:10'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'factor') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLFunnyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLFunnyRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:08'! name ^ 'Avoid "funny"'! ! !TLFunnyRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:55'! rationale ^ 'Avoid it as a means of introduction. Do not announce that something is funny, it should be by itself. Misused words and expressions (page 50) - The Elements of Style - W. Strunk and E.B. White'! ! !TLFunnyRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:54'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLFunnyRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:55'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'funny') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLHoweverRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHoweverRule methodsFor: 'running' stamp: 'lr 9/8/2010 10:47'! name ^ 'Avoid "however"'! ! !TLHoweverRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:22'! 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 6/3/2010 19:06'! runOn: aDocument ^ self runOnSentencesIn: aDocument ! ! !TLHoweverRule methodsFor: 'running' stamp: 'lr 6/12/2010 17:12'! runOnSentence: aSentence | results | results := OrderedCollection new. aSentence words isEmpty ifTrue: [^results]. (aSentence words first text sameAs: 'however') ifTrue: [ results add: (TLRuleFailure on: self at: aSentence words first)]. ^results ! ! TLTextLintRule subclass: #TLImportantlyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLImportantlyRule methodsFor: 'running' stamp: 'lr 9/8/2010 11:08'! name ^ 'Avoid "importantly"'! ! !TLImportantlyRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:16'! rationale ^ 'Avoid by rephrasing. More importantly, she paid for the damages. -> What''s more, she paid for the damages. Misused words and expressions (page 49) - The Elements of Style - W. Strunk and E.B. White'! ! !TLImportantlyRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:13'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLImportantlyRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:16'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'importantly') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLInsightfulRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInsightfulRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:08'! name ^ 'Avoid "insightful"'! ! !TLInsightfulRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:45'! rationale ^ 'The word is a suspicious overstatement for perceptive. Only used for remarkable visions. That was an insightful remark you made -> That was a perceptive remark you made. Misused words and expressions (page 50) - The Elements of Style - W. Strunk and E.B. White'! ! !TLInsightfulRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:43'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLInsightfulRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:46'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'insightful') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLInterestingRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInterestingRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid "interesting"'! ! !TLInterestingRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:51'! rationale ^ 'Avoid it as a means of introduction. Do not announce that something is interesting. Misused words and expressions (page 50) - The Elements of Style - W. Strunk and E.B. White'! ! !TLInterestingRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:50'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLInterestingRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:52'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'interesting') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! TLTextLintRule subclass: #TLIrregardlessRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLIrregardlessRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:09'! name ^ 'Avoid "irregardless"'! ! !TLIrregardlessRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:59'! rationale ^ 'Should be regardless. With its illogical negative prefix, is widely heard, perhaps arising under the influence of such perfectly correct forms as : irrespective. Irregardless is avoided by careful users of English. Misused words and expressions (page 50) - The Elements of Style - W. Strunk and E.B. White'! ! !TLIrregardlessRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:58'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLIrregardlessRule methodsFor: 'running' stamp: 'JorgeRessia 7/30/2010 23:59'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'irregardless') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^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: 'JorgeRessia 7/29/2010 14:34'! rationale ^ ' Do not join sentences with commas German you can join clauses with commas; in English you must make them separate sentences, or you may join them with colons ( : ), semi-colons ( ; ), dashes (--), or conjunctions (and ...). Wrong: "RetroVue is another commercial back-in-time debugger, it implements the most common functions." Right: "RetroVue is another commercial back-in-time debugger; it implements the most common functions." The next words are exceptions taken into account, the rule holds if the comma is placed before one of these words: ' , (self wordsBeforeComma inject: ' ' into: [:sum :each | sum, ' ', each, ',' ]) trimRight: [:each | each = $,].! ! !TLJoinedSentencesWithCommasRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 19:06'! runOn: aDocument ^ self runOnSentencesIn: aDocument ! ! !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: 'JorgeRessia 5/28/2010 11:25'! rationale ^ 'Paragraphs with more than ', self maxSentencesPerParagraph asString , ' are too long, they should be divided in more paragraphs'! ! !TLLongParagraphRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 19:07'! runOn: aDocument ^ self runOnParagraphsIn: aDocument ! ! !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: 'JorgeRessia 5/28/2010 10:44'! rationale ^ 'Sentences of more than ', self maxWordsPerSentence asString , ' are too long, this sentence should be divided in two or more simpler sentences.'! ! !TLLongSentenceRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 19:06'! runOn: aDocument ^ self runOnSentencesIn: aDocument ! ! !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: #TLNoSpacesBeforePunctuationMarkRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid whitespace'! ! !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 6/3/2010 19:06'! runOn: aDocument ^ self runOnSentencesIn: aDocument ! ! !TLNoSpacesBeforePunctuationMarkRule methodsFor: 'running' stamp: 'JorgeRessia 5/28/2010 11:02'! runOnSentence: aSentence | results children aWord | results := OrderedCollection new. children := aSentence children. children do: [:each | ((each isPunctuation) and: [each text = ',']) ifTrue: [ aWord := children at: (children indexOf: each ) - 1 ifAbsent: [ ^ results ]. (aWord isWhitespace and: [aWord text = ' ']) ifTrue: [results add: (TLRuleFailure on: self at: each)]] ]. ^results ! ! TLTextLintRule subclass: #TLPassiveVoiceRule instanceVariableNames: 'regex' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLPassiveVoiceRule methodsFor: 'initialize-release' stamp: 'lr 9/5/2010 22:07'! initialize "http://matt.might.net/articles/shell-scripts-for-passive-voice-weasel-words-duplicates/" super initialize. regex := '\b(am|are|were|being|is|been|was|be)\b\s+(\w+ed|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)\b' asRegex! ! !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: 'running' stamp: 'lr 9/5/2010 22:02'! runOn: aDocument ^ self runOnSentencesIn: aDocument! ! !TLPassiveVoiceRule methodsFor: 'running' stamp: 'lr 9/5/2010 22:07'! runOnSentence: aSentence | results | results := OrderedCollection new. (regex matchesIn: aSentence text) isEmpty ifFalse: [ results add: (TLRuleFailure on: self at: aSentence) ]. ^ 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 9/2/2010 21:13'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'a'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'lot'). ^aRulePattern! ! !TLALotRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:47'! name ^ 'Avoid "a lot"'! ! !TLALotRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:29'! 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 9/3/2010 11:55'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'a'); anyNumberOf: (TLWhitespace new); wordMatching: '([aeiouAEIOU]).*' except: self specialCases. ^aRulePattern! ! !TLARule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid "a"'! ! !TLARule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:30'! 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: '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: '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.'! ! !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 9/3/2010 11:58'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'an'); anyNumberOf: (TLWhitespace new); wordMatching: '([^aeiouAEIOU]).*' except: self specialCases. ^aRulePattern! ! !TLAnRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:54'! name ^ 'Avoid "an"'! ! !TLAnRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:30'! 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: '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: 'lr 9/8/2010 10:52'! name ^ 'Avoid "as to wether"'! ! !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: #TLCannotRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLCannotRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/30/2010 14:58'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'can'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'not'). ^aRulePattern! ! !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.'! ! !TLCannotRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/30/2010 14:57'! sizeInWords ^2! ! TLPhraseRule subclass: #TLDifferentThanRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLDifferentThanRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 23:01'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'different'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'than'). ^aRulePattern! ! !TLDifferentThanRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:57'! name ^ 'Avoid "different than"'! ! !TLDifferentThanRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 23:05'! rationale ^ 'Here logic supports stablished usage: one thing differs from another, hence, different from. Or other than, unlike. Misused words and expressions (page 44) - The Elements of Style - W. Strunk and E.B. White'! ! !TLDifferentThanRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 23:01'! sizeInWords ^2! ! TLPhraseRule subclass: #TLDoubtButRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLDoubtButRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 22:14'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'doubt'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'but'). ^aRulePattern! ! !TLDoubtButRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:57'! name ^ 'Avoid "doubt but"'! ! !TLDoubtButRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 22:16'! rationale ^ 'But is unnecessary after doubt. I have not doubt but that, should be written as I have no doubt that. Misused words and expressions (page 41) - The Elements of Style - W. Strunk and E.B. White'! ! !TLDoubtButRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 22:17'! sizeInWords ^2! ! TLPhraseRule subclass: #TLEachAndEveryOneRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLEachAndEveryOneRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 23:16'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'each'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'and'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'every'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'one'). ^aRulePattern! ! !TLEachAndEveryOneRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:58'! name ^ 'Avoid "each and every one"'! ! !TLEachAndEveryOneRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 23:18'! rationale ^ 'Jargon, avoid except in dialog. It should be a lesson for each and every one of us -> It should be a lesson to every one of us (to us all). Misused words and expressions (page 45) - The Elements of Style - W. Strunk and E.B. White'! ! !TLEachAndEveryOneRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 23:15'! sizeInWords ^4! ! TLPhraseRule subclass: #TLHelpButRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLHelpButRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 22:22'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'help'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'but'). ^aRulePattern! ! !TLHelpButRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:58'! name ^ 'Avoid "help but"'! ! !TLHelpButRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:33'! rationale ^ 'But is unnecessary after "help". He could not help but see that, should be written as He could not help seeing that. Misused words and expressions (page 41) - The Elements of Style - W. Strunk and E.B. White'! ! !TLHelpButRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/29/2010 22:22'! sizeInWords ^2! ! 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: '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.'! ! !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: '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.'! ! !TLInOrderToRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/13/2010 19:55'! sizeInWords ^3! ! TLPhraseRule subclass: #TLInRegardsToRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInRegardsToRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:24'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'in'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'regards'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'to'). ^aRulePattern! ! !TLInRegardsToRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:59'! name ^ 'Avoid "in regards to"'! ! !TLInRegardsToRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:34'! rationale ^ 'Often wrongly written "in regards to", should be in regard to. Misused words and expressions (page 49) - The Elements of Style - W. Strunk and E.B. White'! ! !TLInRegardsToRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:24'! sizeInWords ^3! ! TLPhraseRule subclass: #TLInTermsOfRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLInTermsOfRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:35'! matchingPattern | aRulePattern | aRulePattern := TLRulePattern new. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'in'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'terms'); anyNumberOf: (TLWhitespace new); with: (TLCaseInsensitiveWordPattern on: 'of'). ^aRulePattern! ! !TLInTermsOfRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:59'! name ^ 'Avoid "in terms of"'! ! !TLInTermsOfRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:37'! rationale ^ 'A piece of padding usually best omitted. The job was unattractive in terms of salary -> The salary made the job unattractive. Misused words and expressions (page 50) - The Elements of Style - W. Strunk and E.B. White'! ! !TLInTermsOfRule methodsFor: 'accessing' stamp: 'JorgeRessia 7/30/2010 23:35'! 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: 'lr 9/8/2010 10:55'! name ^ 'Avoid comma'! ! !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: #TLNoContractionsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoContractionsRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/30/2010 20:29'! matchingPattern | aRulePattern contractions | aRulePattern := TLRulePattern new. contractions := OrderedCollection new add: (TLCaseInsensitiveWordPattern on: 've'); add: (TLCaseInsensitiveWordPattern on: 't'); add: (TLCaseInsensitiveWordPattern on: 'd'); add: (TLCaseInsensitiveWordPattern on: 'll'); yourself. aRulePattern anyword; anyNumberOf: (TLPunctuationMark with: (PPToken on: '''')); anyOf: contractions. ^aRulePattern! ! !TLNoContractionsRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 10:55'! name ^ 'Avoid contraction'! ! !TLNoContractionsRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/30/2010 20:25'! rationale ^ 'Contractions are not allowed since they could be ambiguous like I''d which could mean I had or I would'! ! !TLNoContractionsRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/30/2010 20:24'! 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: 'lr 9/8/2010 10:55'! name ^ 'Avoid "one of the most"'! ! !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: '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 6/3/2010 19:06'! runOn: aDocument ^ self runOnSentencesIn: aDocument! ! !TLPhraseRule methodsFor: 'running' stamp: 'JorgeRessia 9/3/2010 11:32'! runOnSentence: aSentence "We do not take into account the markups since they do not form the text itself." | results | results := OrderedCollection new. (aSentence allPhrasesOfSize: self sizeInWords) do: [:eachPhrase | (self pattern matches: eachPhrase phraseWithoutMarkups ) 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: 'lr 9/8/2010 10:55'! name ^ 'Avoid "regarded as"'! ! !TLRegardedAsBeingRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:34'! 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: '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.'! ! !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: 'lr 9/8/2010 10:56'! name ^ 'Avoid "the fact is"'! ! !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: 'lr 9/8/2010 10:56'! name ^ 'Avoid "the fact that"'! ! !TLTheFactThatRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:35'! 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: 'lr 9/8/2010 10:56'! name ^ 'Avoid "the truth is"'! ! !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! ! TLPhraseRule subclass: #TLTrueFactRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLTrueFactRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 14:26'! matchingPattern | aRulePattern aWord anotherWord | aRulePattern := TLRulePattern new. aWord := TLCaseInsensitiveWordPattern on: 'fact'. anotherWord := TLCaseInsensitiveWordPattern on: 'facts'. aRulePattern with: (TLCaseInsensitiveWordPattern on: 'true'); anyNumberOf: (TLWhitespace new); anyOf: (OrderedCollection with: aWord with: anotherWord). ^aRulePattern! ! !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.'! ! !TLTrueFactRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 14:19'! sizeInWords ^2! ! 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: 'lr 9/8/2010 10:59'! name ^ 'Avoid "somehow"'! ! !TLSomehowRule methodsFor: 'accessing' stamp: 'JorgeRessia 9/2/2010 19:35'! rationale ^ 'Avoid using the word "somehow". Is too general and weakens the sentence'! ! !TLSomehowRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 18:31'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !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: #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: 'JorgeRessia 9/2/2010 19:35'! rationale ^ 'Avoid using the word "stuff"/s. Is too general and weakens the sentence'! ! !TLStuffRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 18:31'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !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 subclass: #TLSyntacticElemensSequenceRule instanceVariableNames: 'pattern' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! TLSyntacticElemensSequenceRule subclass: #TLNoContinuousPunctuationMarksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLNoContinuousPunctuationMarksRule methodsFor: 'running' stamp: 'JorgeRessia 6/10/2010 15:32'! matchingPattern | aRulePattern punctuationMarks | punctuationMarks := OrderedCollection new add: (TLPunctuationMark with: (PPToken on: ',')); add: (TLPunctuationMark with: (PPToken on: '.')); add: (TLPunctuationMark with: (PPToken on: ':')); add: (TLPunctuationMark with: (PPToken on: ';')); add: (TLPunctuationMark with: (PPToken on: '!!')); add: (TLPunctuationMark with: (PPToken on: '?')); yourself. aRulePattern := TLRulePattern new. aRulePattern anyOf: punctuationMarks; anyOf: punctuationMarks. ^aRulePattern! ! !TLNoContinuousPunctuationMarksRule methodsFor: 'accessing' stamp: 'lr 9/8/2010 11:00'! name ^ 'Avoid continuous punctuation'! ! !TLNoContinuousPunctuationMarksRule methodsFor: 'accessing' stamp: 'JorgeRessia 5/28/2010 11:06'! rationale ^'There should be no continuous punctuation marks.'! ! !TLNoContinuousPunctuationMarksRule methodsFor: 'running' stamp: 'JorgeRessia 6/10/2010 15:43'! sizeInElements ^2! ! !TLSyntacticElemensSequenceRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 15:14'! matchingPattern ^self subclassResponsibility ! ! !TLSyntacticElemensSequenceRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 15:14'! pattern ^ pattern ifNil: [ pattern := self matchingPattern ]! ! !TLSyntacticElemensSequenceRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 15:26'! rationale ^ 'This rule checks for specific syntactic elements sequence in the whole document.'! ! !TLSyntacticElemensSequenceRule methodsFor: 'running' stamp: 'JorgeRessia 6/10/2010 15:14'! runOn: aDocument ^ self runOnSentencesIn: aDocument! ! !TLSyntacticElemensSequenceRule methodsFor: 'running' stamp: 'JorgeRessia 6/10/2010 15:31'! runOnSentence: aSentence | results | results := OrderedCollection new. (aSentence allSequencesOfSize: self sizeInElements) do: [:eachSequence | (self pattern matches: eachSequence) ifTrue: [results add: (TLRuleFailure on: self at: eachSequence)] ]. ^results ! ! !TLSyntacticElemensSequenceRule methodsFor: 'accessing' stamp: 'JorgeRessia 6/10/2010 15:43'! sizeInElements ^self subclassResponsibility ! ! !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: '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 6/3/2010 18:29'! runOnParagraphsIn: aDocument ^ aDocument paragraphs gather: [ :each | self runOnParagraph: each ]! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 5/26/2010 10:25'! 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: 'JorgeRessia 5/26/2010 10:26'! runOnWord: aWord ^#()! ! !TLTextLintRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 18:28'! runOnWordsIn: aDocument ^ aDocument words gather: [ :each | self runOnWord: each ]! ! TLTextLintRule 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: 'JorgeRessia 9/2/2010 19:35'! rationale ^ 'Avoid using the word "thing"/s. Is too general and weakens the sentence'! ! !TLThingRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 18:31'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !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: #TLThusRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLThusRule methodsFor: 'running' 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.'! ! !TLThusRule methodsFor: 'running' stamp: 'JorgeRessia 7/31/2010 10:45'! runOn: aDocument ^ self runOnSentencesIn: aDocument ! ! !TLThusRule methodsFor: 'running' stamp: 'JorgeRessia 7/31/2010 10:46'! runOnSentence: aSentence | results | results := OrderedCollection new. aSentence words isEmpty ifTrue: [^results]. (aSentence words first text sameAs: 'thus') ifTrue: [ results add: (TLRuleFailure on: self at: aSentence words first)]. ^results ! ! 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: 'JorgeRessia 4/12/2010 10:15'! rationale ^ 'The constant repetition of the same words in a paragraph is weakening'! ! !TLWordRepetitionInParagraphRule methodsFor: 'running' stamp: 'JorgeRessia 6/3/2010 19:07'! runOn: aDocument ^ self runOnParagraphsIn: aDocument ! ! !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! ! TLTextLintRule subclass: #TLWouldRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model-Rules'! !TLWouldRule methodsFor: 'running' 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.'! ! !TLWouldRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 14:46'! runOn: aDocument ^ self runOnWordsIn: aDocument ! ! !TLWouldRule methodsFor: 'running' stamp: 'JorgeRessia 7/29/2010 14:46'! runOnWord: aWord | results | results := OrderedCollection new. (aWord text sameAs: 'would') ifTrue: [results add: (TLRuleFailure on: self at: aWord)]. ^results ! ! 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: 'FabrizioPerin 7/30/2010 09:36'! scientificPaperStyle |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: '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! !