SystemOrganization addCategory: #'TextLint-Console'! TLPlainTokenizer subclass: #TLOrgModeTokenizer instanceVariableNames: '' classVariableNames: 'NewLineParser' poolDictionaries: '' category: 'TextLint-Console'! !TLOrgModeTokenizer commentStamp: 'DamienCassou 9/9/2011 11:00' prior: 0! I tokenize files as if they were from the Emacs org-mode format (http://orgmode.org/)! !TLOrgModeTokenizer class methodsFor: 'class initialization' stamp: 'DamienCassou 9/9/2011 09:22'! initialize "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple." NewLineParser := (Character lf asParser) / (Character cr asParser , Character lf asParser optional)! ! !TLOrgModeTokenizer methodsFor: 'tokens' stamp: 'DamienCassou 9/12/2011 18:08'! markup ^ (NewLineParser, '*' asParser plus, ' ' asParser) token ==> [:token | TLWhitespace with: String lf, String lf "two new line characters to force a new paragraph"]! ! !TLOrgModeTokenizer methodsFor: 'tokens' stamp: 'DamienCassou 9/12/2011 18:08'! whitespace "Same as in superclass but avoid consuming a new-line character as it is used to detect markups" ^ (#blank asParser plus / #newline asParser plus) token ==> (super whitespace block)! ! !TLSyntacticElement methodsFor: '*textlint-console' stamp: 'lr 9/5/2011 20:46'! startColumn "Answer the start column of the receiver." ^ self token column! ! !TLSyntacticElement methodsFor: '*textlint-console' stamp: 'lr 9/5/2011 20:46'! startLine "Answer the start line of the receiver." ^ self token line! ! Object subclass: #TLConsole instanceVariableNames: 'filename content checker outputStream' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Console'! !TLConsole class methodsFor: 'action' stamp: 'lr 9/3/2011 16:12'! checkFileNamed: inputString andOutputToFileNamed: outputString withinDirectory: directoryString (FileDirectory on: directoryString) readOnlyFileNamed: inputString do: [ :inputStream | (FileDirectory on: directoryString) forceNewFileNamed: outputString do: [ :outputStream | outputStream nextPutAll: (self new setFilename: inputString content: inputStream contents; check) ] ]. Smalltalk snapshot: false andQuit: true! ! !TLConsole methodsFor: 'action' stamp: 'DamienCassou 9/9/2011 11:01'! check "TODO: needs a better way to choose the tokenizer. And possibly let emacs specify the one it wants" (filename endsWith: '.org') ifTrue: [checker parse: content tokenizer: TLOrgModeTokenizer] ifFalse: [checker parse: content]. outputStream := WriteStream on: (String new: 1000). checker results do: [:failure | self processFailure: failure. outputStream lf]. ^ outputStream contents! ! !TLConsole methodsFor: 'private' stamp: 'DamienCassou 9/2/2011 19:28'! printContext: anElement "Print error message in gnu-style (http://www.gnu.org/prep/standards/html_node/Errors.html)" outputStream nextPutAll: filename; nextPut: $:. (anElement children isEmpty) ifTrue: [outputStream print: anElement token line; nextPut: $.; print: anElement token column] ifFalse: ["(anElement children last token line ~= anElement children first token line) ifTrue: ["outputStream print: anElement children first token line; nextPut: $.; print: anElement children first token column; nextPut: $-; print: anElement children last token line; nextPut: $.; print: anElement children last token column + anElement children last token size - 1"] ifFalse: [outputStream print: anElement children first token line; nextPut: $.; print: anElement children first token column; nextPut: $-; print: anElement children last token column + anElement children last token size]"]. outputStream nextPut: $:! ! !TLConsole methodsFor: 'private' stamp: 'DamienCassou 9/2/2011 16:45'! printFailingText: anElement outputStream nextPutAll: anElement text withBlanksTrimmed ! ! !TLConsole methodsFor: 'private' stamp: 'DamienCassou 9/2/2011 16:44'! printRule: aRule outputStream nextPutAll: aRule name; nextPutAll: ': '; nextPutAll: aRule rationale! ! !TLConsole methodsFor: 'private' stamp: 'DamienCassou 9/2/2011 17:06'! processFailure: aFailure self printContext: aFailure element. outputStream space. self printRule: aFailure rule. outputStream lf;tab. self printFailingText: aFailure element ! ! !TLConsole methodsFor: 'initialize-release' stamp: 'DamienCassou 9/2/2011 16:18'! setFilename: aString content: anotherString filename := aString. content := anotherString. checker := TLTextLintChecker new. checker addStyle: TLWritingStyle scientificPaperStyle.! ! Object subclass: #TLTextMate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Console'! !TLTextMate class methodsFor: 'action' stamp: 'lr 9/5/2011 20:56'! checkInput: inputName output: outputName | checker | checker := TLTextLintChecker new. checker addStyle: TLWritingStyle scientificPaperStyle. FileStream readOnlyFileNamed: inputName do: [ :inputStream | checker parse: inputStream contents ]. FileStream forceNewFileNamed: outputName do: [ :outputStream | | groups | groups := checker results groupedBy: [ :each | each rule class ]. groups := groups values asOrderedCollection sorted: [ :a :b | a first rule name < b first rule name ]. groups do: [ :failures | | rule | rule := failures first rule. outputStream nextPutAll: '

'; nextPutAll: rule name; nextPutAll: '

'; cr. outputStream nextPutAll: '

'; nextPutAll: rule rationale; nextPutAll: '

'; cr. outputStream nextPutAll: ''; cr ] ]. Smalltalk snapshot: false andQuit: true! ! !TLElement methodsFor: '*textlint-console' stamp: 'lr 9/5/2011 20:45'! startColumn "Answer the start column of the receiver." ^ self children isEmpty ifFalse: [ self children first startColumn ] ifTrue: [ 1 ]! ! !TLElement methodsFor: '*textlint-console' stamp: 'lr 9/5/2011 20:45'! startLine "Answer the start line of the receiver." ^ self children isEmpty ifFalse: [ self children first startLine ] ifTrue: [ 1 ]! ! TestCase subclass: #TLOrgModeTokenizerTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Console'! !TLOrgModeTokenizerTest methodsFor: 'helpers' stamp: 'DamienCassou 9/12/2011 18:25'! parse: aString ^ self phrase: (self tokenize: aString)! ! !TLOrgModeTokenizerTest methodsFor: 'helpers' stamp: 'DamienCassou 9/12/2011 18:23'! phrase: tokens ^ TLTextPhraser parse: tokens! ! !TLOrgModeTokenizerTest methodsFor: 'tests' stamp: 'DamienCassou 9/12/2011 18:21'! testGroupSpaces | tokens document | tokens := self tokenize: 'something bla'. self assert: tokens size equals: 4! ! !TLOrgModeTokenizerTest methodsFor: 'tests' stamp: 'DamienCassou 9/12/2011 18:25'! testHeadingMarkupTriggerNewParagraph | text tokens document | text := 'something ' , String lf , '*** bla'. document := self parse: text. self assert: document paragraphs size equals: 2. text := 'something *** bla'. document := self parse: text. self assert: document paragraphs size equals: 1. text := 'something ' , String lf , String lf , '*** bla'. document := self parse: text. self assert: document paragraphs size equals: 2! ! !TLOrgModeTokenizerTest methodsFor: 'helpers' stamp: 'DamienCassou 9/12/2011 18:30'! tokenize: text | tokens | tokens := TLOrgModeTokenizer parse: text. ^ tokens! ! TLOrgModeTokenizer initialize!