SystemOrganization addCategory: #'TextLint-View-Browser'!
SystemOrganization addCategory: #'TextLint-View-Wizard'!

Announcement subclass: #TLFileSaved
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TextLint-View-Browser'!

Announcement subclass: #TLStyleChanged
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TextLint-View-Browser'!

Object subclass: #TLCodeBrowser
	instanceVariableNames: 'textLintChecker results saveAnnouncer lastRuleSelectionInterval styleAnnouncer'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TextLint-View-Browser'!

!TLCodeBrowser class methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/10/2010 13:12'!
newFor: aStyle
	^self new initializeWith: aStyle! !

!TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 10/19/2010 17:19'!
codeBrowser

	| browser |
		
	browser := GLMTabulator new.
	browser title: 'TextLint Results Browser'.
	browser 
			row: [ :row | 
				row 
					column: [:col | 
						col
							row: #files span: 3;
							row: #styles size: 30.];
					column: [ :col |
						col
							row: #errors span: 3;
							row: #rationale span: 2;
							row: #export size: 30] span: 3 ];
			row: #code.
	
	self filesPaneOn: browser.
	self stylePaneOn: browser.
	self errorsPaneOn: browser.
	self rationalePaneOn: browser.
	self codePaneOn: browser.
	self exportButtonOn: browser.
	
	browser transmit 
		to: #code->#selectionInterval; 
		from: #errors; when: [:s | s notNil and: [ s isCollection not ]] ; 
		transformed: [ :s | 
			lastRuleSelectionInterval := Interval 
				from: (s element interval first -  s element interval size) 
				to: (s element interval last -  s element interval size).
			s element interval].
	
	saveAnnouncer 
		when: TLFileSaved 
		do: [:announcement |
					browser transmit
						to: #code->#selectionInterval;
						when: [:s | lastRuleSelectionInterval isNil not.]; 
						transformed: [ :s | lastRuleSelectionInterval]].
	browser transmit 
		from: #styles;
		to:#styles; when: [:s | s notNil] ; 
		transformed: [ :s | 
			self reInitializeCheckerWith: s.
			styleAnnouncer announce: TLStyleChanged.
			s].
	
	^browser! !

!TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 10/19/2010 17:22'!
codePaneOn: browser

	browser transmit 
		to: #code;
		from: #files;
		"from: #styles;"
		andShow: [:presentation | 
					presentation text 
							title: [:file | file name ];
							display: [:file | 
								| text |
								textLintChecker isNil ifFalse: [ 
									text := textLintChecker document highlightedText.
									results do: [ :each | each highlightOn: text ].].
								text. ];
							act: [:text :file |
								MultiByteFileStream
									forceNewFileNamed: file
									do: [ :stream | stream nextPutAll: text text ].

								saveAnnouncer announce: TLFileSaved.
								
								"(text pane browser paneNamed: #code) presentations do: [:pres | pres update]."
								] on: $s entitled: 'Save modifications [cmd-s]';
							updateOn: TLFileSaved from: [saveAnnouncer];
							updateOn: TLStyleChanged from:[styleAnnouncer].	
						].
	
	^browser! !

!TLCodeBrowser methodsFor: 'Glamour' stamp: 'JorgeRessia 5/12/2011 13:43'!
errorsPaneOn: browser
	| fileContents |
	browser transmit 
		to: #errors; 
		from: #files;
	"	from: #styles;"
		andShow: [:presentation | 
			presentation tree 
				title: 'Errors';
				display: [ :file | 
					Cursor wait showWhile: [
						fileContents := MultiByteFileStream
							readOnlyFileNamed: file
							do: [ :stream | stream contents ].
						results := (textLintChecker parse: fileContents) results.
						(results groupedBy: [ :each | each rule class ]) values. ]];
				children: [ :item :x :level |
					item isCollection 
						ifTrue: [ item ]
						ifFalse: [ #() ]];
				format: [ :each | 
					each isCollection
						ifTrue: [ each first rule name ]
						ifFalse: [
							String streamContents: [ :stream | stream nextPutAll: (each element processFor: self)] ] ];
				updateOn: TLFileSaved from: [saveAnnouncer];
				updateOn: TLStyleChanged from:[styleAnnouncer.]
			].
		^ browser! !

!TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 9/8/2010 14:29'!
exportButtonOn: aBrowser

	aBrowser transmit 
		to: #export;
		from: #files;
		andShow: [ :a |			
			a actionList 
				act: [:presentation :filePath | 
					Cursor wait showWhile:[							
							| fileStream cursor |
							cursor := 1.
							fileStream := CrLfFileStream forceNewFileNamed: ((filePath sliceFrom: ((filePath findLastOccurrenceOfString: FileDirectory slash startingAt: 1) + 1) to: (filePath size - 4)) , '.out').
							results do: [:failure |
								fileStream nextPutAll: failure rule name.
								fileStream nextPutAll: ' - '.
								fileStream nextPutAll: failure rule rationale.
								fileStream nextPutAll: String cr.].
							fileStream flush.
							fileStream close.].
				StandardWindow new message: 'Export completed'.
						] 
				entitled: 'Export'].
			
		^aBrowser
	
! !

!TLCodeBrowser methodsFor: 'Glamour' stamp: 'lr 5/28/2010 10:38'!
filesPaneOn: aBrowser
	| parent |
	aBrowser transmit 
		to: #files; 
		andShow: [ :brow | 
			brow list 
				title: 'Files';
				format: [ :name | name allButFirst: parent pathName size + 1 ];
				display: [ :folder |
					((parent := folder) fullNamesOfAllFilesInSubtree 
						select: [ :each | (each endsWith: '.txt') or: [ (each endsWith: '.tex') or: [ each endsWith: '.html' ] ] ]) ] ]! !

!TLCodeBrowser methodsFor: 'initialization' stamp: 'FabrizioPerin 10/19/2010 17:10'!
initialize
	super initialize.
	textLintChecker := TLTextLintChecker new.
	saveAnnouncer := Announcer new.
	styleAnnouncer := Announcer new.
	lastRuleSelectionInterval := nil.! !

!TLCodeBrowser methodsFor: 'initialization' stamp: 'lr 5/28/2010 10:48'!
initializeWith: aStyle
	textLintChecker := TLTextLintChecker new.
	aStyle rules do: [:rule | textLintChecker addRule: rule ].! !

!TLCodeBrowser methodsFor: 'element printing' stamp: 'JorgeRessia 6/16/2010 15:33'!
processDocument: aDocument

	^aDocument text! !

!TLCodeBrowser methodsFor: 'element printing' stamp: 'JorgeRessia 6/16/2010 16:18'!
processParagraph: aParagraph
	
	^String streamContents: [ :stream |
								stream nextPutAll: ' ('; print: aParagraph sentences size; nextPutAll: ' senteces) '.
								stream nextPutAll: aParagraph text withBlanksTrimmed.
								stream position > 20
									ifTrue: [ stream position: 40; nextPutAll: '...' ].
								stream nextPutAll: ' (line '; print: aParagraph token line; nextPut: $) ]
! !

!TLCodeBrowser methodsFor: 'element printing' stamp: 'JorgeRessia 6/16/2010 15:50'!
processPhrase: aPhrase
	
	^String streamContents: [ :stream |
								stream nextPutAll: aPhrase text withBlanksTrimmed.
								stream nextPutAll: ' (line '; print: aPhrase token line; nextPut: $) ]
	! !

!TLCodeBrowser methodsFor: 'element printing' stamp: 'JorgeRessia 6/16/2010 16:18'!
processSentence: aSentence
	
	| aStream |
	^String streamContents: [ :stream |
								stream nextPutAll: ' ('; print: aSentence words size; nextPutAll: ' words) '.
								stream nextPutAll: aSentence text withBlanksTrimmed.
								stream position > 20
									ifTrue: [ stream position: 40; nextPutAll: '...' ].
								stream nextPutAll: ' (line '; print: aSentence token line; nextPut: $) ]
! !

!TLCodeBrowser methodsFor: 'element printing' stamp: 'JorgeRessia 6/16/2010 15:49'!
processSyntacticElement: aSyntacticElement
	
	^String streamContents: [ :stream |
								stream nextPutAll: aSyntacticElement text withBlanksTrimmed.
								stream nextPutAll: ' (line '; print: aSyntacticElement token line; nextPut: $) ]
	! !

!TLCodeBrowser methodsFor: 'Glamour' stamp: 'lr 5/30/2010 20:15'!
rationalePaneOn: aBrowser

	aBrowser transmit 
		to: #rationale; 
		from: #errors; 
		andShow: [:a | a text 
							title: 'Rationale'; 
							display: [:r | 
								r isCollection
									ifTrue: [ r first rule rationale ]
									ifFalse: [ r rule rationale ] ] ].
	
	^aBrowser! !

!TLCodeBrowser methodsFor: 'private' stamp: 'FabrizioPerin 10/1/2010 16:10'!
reInitializeCheckerWith: aStyleName
	
	aStyleName = 'Scientific Paper Style' 
		ifTrue: [
			textLintChecker := TLTextLintChecker new.
			TLWritingStyle scientificPaperStyle rules do: [:rule | textLintChecker addRule: rule ].].
! !

!TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 10/20/2010 11:01'!
stylePaneOn: browser

	browser transmit 
		to: #styles; 
		andShow: [:a | 
			a dropDownList
					display: [:folderPathString | 
						| listOfSyles |
						listOfSyles := OrderedCollection with: (TLWritingStyle scientificPaperStyle name).
						self reInitializeCheckerWith: (listOfSyles at: 1).
						listOfSyles];
					selectedIndex: 1
					].
	
	^browser	
	! !

Object subclass: #TLWizardGUI
	instanceVariableNames: 'progBar'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TextLint-View-Wizard'!

!TLWizardGUI class methodsFor: 'initialization' stamp: 'FabrizioPerin 6/23/2010 11:10'!
initialize
	self registerInWorldMenu! !

!TLWizardGUI class methodsFor: 'initialization' stamp: 'FabrizioPerin 6/23/2010 11:10'!
menuCommandOn: aBuilder 
	<worldMenu> 
	(aBuilder item: #'TextLint')
			parent: #Tools;
			action: [self open]; 
			help: 'Tool to analyze latex files according with predefinde writing styles'.! !

!TLWizardGUI class methodsFor: 'instance creation' stamp: 'FabrizioPerin 4/21/2010 17:13'!
open
	^ self new open! !

!TLWizardGUI class methodsFor: 'instance creation' stamp: 'FabrizioPerin 6/23/2010 11:09'!
registerInWorldMenu
	self environment at: #TheWorldMenu ifPresent: [ :class |
		 ((class respondsTo: #registerOpenCommand:)
			and: [((class class >>#registerOpenCommand:) sendsSelector: #deprecated:) not])
 	     			ifTrue: [class registerOpenCommand: { 'textLint' . {self. #open}}]]
! !

!TLWizardGUI methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 10/19/2010 17:25'!
open
	| directory |
	directory := UITheme builder chooseDirectory: 'Select the directory containing the files to analyze'.
	directory isNil ifFalse: [		
		TLCodeBrowser new codeBrowser openOn: directory .].! !

!TLRuleFailure methodsFor: '*textlint-view' stamp: 'FabrizioPerin 5/31/2010 15:13'!
highlightAttribute
	^ TextColor red! !

!TLRuleFailure methodsFor: '*textlint-view' stamp: 'FabrizioPerin 5/31/2010 14:53'!
highlightOn: aText
	aText addAttribute: self highlightAttribute from: self element start to: self element stop
	! !

!TLMarkup methodsFor: '*textlint-view' stamp: 'FabrizioPerin 5/31/2010 15:17'!
highlightAttribute
	^ TextColor gray! !

!TLElement methodsFor: '*textlint-view' stamp: 'FabrizioPerin 5/31/2010 14:43'!
highlightOn: aText
	self children do: [ :each | each highlightOn: aText ]! !

!TLElement methodsFor: '*textlint-view' stamp: 'FabrizioPerin 5/31/2010 14:45'!
highlightedText
	| text |
	text := self text asText.
	self highlightOn: text.
	^  text! !

!TLSyntacticElement methodsFor: '*textlint-view' stamp: 'FabrizioPerin 5/31/2010 14:37'!
highlightAttribute
	^ TextColor black! !

!TLSyntacticElement methodsFor: '*textlint-view' stamp: 'FabrizioPerin 5/31/2010 14:37'!
highlightOn: aText
	aText addAttribute: self highlightAttribute from: self start to: self stop
	! !
TLWizardGUI initialize!