SystemOrganization addCategory: #'TextLint-Console'!

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/2/2011 18:07'!
check
	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: '<h3>'; nextPutAll: rule name; nextPutAll: '</h3>'; cr.
			outputStream nextPutAll: '<p>'; nextPutAll: rule rationale; nextPutAll: '</p>'; cr.
			outputStream nextPutAll: '<ul>'; cr.
			failures do: [ :failure |
				| text |
				text := failure element text.
				text size > 30 ifTrue: [ text := (text first: 30) , '...' ].
				outputStream 
					tab; nextPutAll: '<li><a href="txmt://open/?url=file://'; nextPutAll: inputName encodeForHTTP; 
					nextPutAll: '&line='; print: failure element startLine; nextPutAll: '&column='; print: failure element startColumn; 
					nextPutAll: '">'; nextPutAll: text; nextPutAll: '</a></li>'; cr ].
			outputStream nextPutAll: '</ul>'; 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 ]! !

!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! !