SystemOrganization addCategory: #'TextLint-View-Browser'! SystemOrganization addCategory: #'TextLint-View-Wizard'! WizardPart subclass: #TLCheckboxPart instanceVariableNames: 'model label checkbox' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Wizard'! !TLCheckboxPart class methodsFor: 'instance creation' stamp: 'FabrizioPerin 4/6/2010 17:42'! new: aString ^self new initialize: aString; yourself.! ! !TLCheckboxPart methodsFor: 'accessing' stamp: 'FabrizioPerin 4/7/2010 16:26'! checkboxContentMorph ^checkbox! ! !TLCheckboxPart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 4/7/2010 15:24'! checkboxInitializer checkbox := self newCheckboxFor: (model := ValueHolder new contents: true) getSelected: #contents setSelected: #contents: label: label. checkbox buttonMorph selected: true. ^checkbox! ! !TLCheckboxPart methodsFor: 'initialization' stamp: 'FabrizioPerin 4/7/2010 15:24'! initialize: aString super initialize. label := aString. self populateContents: {( self checkboxInitializer )}.! ! !TLCheckboxPart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 4/6/2010 17:42'! outputValue "this method is an abstract method as only the subclass itself know what is the information to send to the WizardPane which will send it to the wizarControl " "return true or false according the checkbox is selected or not" ^ model contents! ! !TLCheckboxPart methodsFor: 'accessing' stamp: 'FabrizioPerin 4/6/2010 17:42'! selected: trueOrFalse "select or unselect the checkbox according the value of trueOrFalse " checkbox buttonMorph selected: trueOrFalse.! ! WizardPart subclass: #TLChooseDirectoryPart instanceVariableNames: 'folderDialog title' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Wizard'! !TLChooseDirectoryPart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/4/2010 10:24'! chooseDirectory folderDialog := FileDialogWindow basicNew initialize; title: title; answerDirectory. ^self folderDialogContentMorph! ! !TLChooseDirectoryPart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/4/2010 10:24'! folderDialogContentMorph "exact copy of newContentMorph method but instead to create a new list of directory it uses the one already present" folderDialog directoryTreeMorph: folderDialog directoryTreeMorph; fileListMorph: folderDialog fileListMorph; previewMorph: folderDialog newPreviewMorph. ^(folderDialog newRow: { folderDialog newColumn: { folderDialog newGroupbox: 'Directory' translated for: folderDialog directoryTreeMorph. (folderDialog newLabelGroup: { 'File name' translated->folderDialog newFileNameTextEntry}) vResizing: #shrinkWrap}. folderDialog newGroupbox: 'File' translated forAll: { folderDialog fileListMorph. folderDialog newActionButtonRow}}, (folderDialog previewMorph notNil ifTrue: [{folderDialog newGroupbox: 'Preview' translated for: folderDialog previewMorph}] ifFalse: [#()])) vResizing: #spaceFill.! ! !TLChooseDirectoryPart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/4/2010 10:24'! initialize super initialize. self populateContents: {( self chooseDirectory )}.! ! !TLChooseDirectoryPart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/4/2010 10:24'! outputValue "this method is an abstract method as only the subclass itself know what is the information to send to the WizardPane which will send it to the wizarControl " ^ folderDialog selectedPathName! ! WizardPart subclass: #TLChooseFilePart instanceVariableNames: 'folderDialog title fileDialog' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Wizard'! !TLChooseFilePart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 4/7/2010 16:38'! chooseFile fileDialog := FileDialogWindow basicNew initialize; title: title; answerOpenFile. ^self fileDialogContentMorph! ! !TLChooseFilePart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 4/7/2010 16:37'! fileDialogContentMorph "exact copy of newContentMorph method but instead to create a new list of directory it uses the one already present" fileDialog directoryTreeMorph: fileDialog directoryTreeMorph; fileListMorph: fileDialog fileListMorph; previewMorph: fileDialog newPreviewMorph. ^(fileDialog newRow: { fileDialog newColumn: { fileDialog newGroupbox: 'Directory' translated for: fileDialog directoryTreeMorph. (fileDialog newLabelGroup: { 'File name' translated->fileDialog newFileNameTextEntry}) vResizing: #shrinkWrap}. fileDialog newGroupbox: 'File' translated forAll: { fileDialog fileListMorph. fileDialog newActionButtonRow}}, (fileDialog previewMorph notNil ifTrue: [{fileDialog newGroupbox: 'Preview' translated for: fileDialog previewMorph}] ifFalse: [#()])) vResizing: #spaceFill.! ! !TLChooseFilePart methodsFor: 'initialization' stamp: 'FabrizioPerin 4/7/2010 16:38'! initialize super initialize. title := ''. self populateContents: {( self chooseFile )}.! ! !TLChooseFilePart methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 4/7/2010 16:37'! outputValue "this method is an abstract method as only the subclass itself know what is the information to send to the WizardPane which will send it to the wizarControl " ^fileDialog selectedPathName! ! WizardPart subclass: #TLMultiCheckboxesPart instanceVariableNames: 'allCheckboxes' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Wizard'! !TLMultiCheckboxesPart class methodsFor: 'instance creation' stamp: 'FabrizioPerin 4/7/2010 16:14'! groupName: aString withAll: aCollectionOfLabels super initialize. ^self new initialize: aCollectionOfLabels inGroupBoxNamed: aString. ! ! !TLMultiCheckboxesPart methodsFor: 'initialize-release' stamp: 'FabrizioPerin 4/7/2010 16:28'! initialize: aCollectionOfLabels inGroupBoxNamed: aName allCheckboxes := OrderedCollection new. aCollectionOfLabels do: [:each | allCheckboxes add: ((TLCheckboxPart new: each) checkboxContentMorph). ]. "elements := self addVerticalSeparatorAtTheMiddleOf: allCheckboxes ." self populateContents: {self newGroupboxNamed: aName WithAll: allCheckboxes} ! ! !TLMultiCheckboxesPart methodsFor: 'accessing - wizard mangement' stamp: 'FabrizioPerin 4/7/2010 16:05'! outputValue "this method is an abstract method as only the subclass itself know what is the information to send to the WizardPane which will send it to the wizarControl " ^ self selectedItems! ! !TLMultiCheckboxesPart methodsFor: 'accessing - wizard mangement' stamp: 'FabrizioPerin 4/7/2010 16:05'! selectedItems "return a collection containing symbols corresponding to the checkboxes selected" | result | result := OrderedCollection new. allCheckboxes do: [ :each | each buttonMorph selected ifTrue: [ result add: each label asSymbol ] ]. ^ result! ! WizardLastPane subclass: #TLWizardOnlyLastPane instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Wizard'! !TLWizardOnlyLastPane methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/4/2010 15:49'! displayButtons terminateButton := self newTerminateButton. self buttons: {cancelButton. terminateButton}.! ! Object subclass: #TLCodeBrowser instanceVariableNames: 'textLintChecker updateblock' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Browser'! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'lr 5/6/2010 10:29'! codeBrowser | browser | browser := GLMTabulator new. browser title: 'TextLint Results Browser'. browser row: [ :r | r column: #files; column: [:col | col row: #errors; row: #refresh size: 30]; column: #rationale]; row: #code. self filesPaneOn: browser. self refreshPaneOn: browser. self errorsPaneOn: browser. self rationalePaneOn: browser. self codePaneOn: browser. browser transmit to: #code->#selectionInterval; from: #errors; when: [:s | s notNil and: [ s isCollection not ] ] ; transformed: [ :s | s element interval]. ^browser! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'lr 5/6/2010 10:38'! codePaneOn: browser browser transmit to: #code; from: #files; andShow: [:a | a text title: [:file | file localName]; display: [:file | | fileContents | fileContents := (StandardFileStream readOnlyFileNamed: file pathName) contentsOfEntireFile. fileContents := (fileContents copyReplaceAll: String crlf with: String cr) copyReplaceAll: String lf with: String cr. fileContents ] ]. ^browser! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'lr 5/6/2010 10:35'! errorsPaneOn: browser browser transmit to: #errors; from: #files; andShow: [:a | a tree title: 'Errors'; display: [:file | | fileContents results | fileContents := (StandardFileStream readOnlyFileNamed: file pathName) contentsOfEntireFile. fileContents := (fileContents copyReplaceAll: String crlf with: String cr) copyReplaceAll: String lf with: String cr. results := textLintChecker check: fileContents. (results groupedBy: [ :each | each rule class ]) values ]; children: [ :each | each isCollection ifTrue: [ each ] ifFalse: [ #() ] ]; format: [ :each | each isCollection ifTrue: [ each first rule name ] ifFalse: [ each element text ] ] ]. ^browser! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'lr 5/6/2010 10:18'! filesPaneOn: aBrowser aBrowser transmit to: #files; andShow: [:brow | brow list title: 'Files'; format: [ :folder | folder localName ]; display: [ :fd | (fd fileNames select: [:each | (each endsWith: '.tex') or: [ each endsWith: '.txt' ] ]) collect: [:each |FileDirectory on: fd pathName, fd pathNameDelimiter asString, each ] ] ]. ^aBrowser! ! !TLCodeBrowser methodsFor: 'initialization' stamp: 'lr 5/6/2010 10:27'! initialize super initialize. textLintChecker := TLTextLintChecker new. TLTextLintRule allSubclassesDo: [:class | class allSubclasses isEmpty ifTrue: [textLintChecker addRule: class new ]].! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'lr 5/6/2010 10:28'! rationalePaneOn: aBrowser aBrowser transmit to: #rationale; from: #errors; andShow: [:a | a text title: 'Rationale'; display: [:results | results isCollection ifTrue: [ results first rule rationale ] ifFalse: [ results rule rationale ] ] ]. ^aBrowser! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 5/4/2010 20:01'! refreshPaneOn: aBrowser aBrowser transmit to: #refresh; andShow: [ :a | a actionList act: [:entity | (aBrowser paneNamed: #errors) presentations do: [:pres | pres update] ] entitled: 'Refresh']. ^aBrowser ! ! WizardControl subclass: #TLWizardGUI instanceVariableNames: 'progBar' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Wizard'! !TLWizardGUI class methodsFor: 'initialization' stamp: 'lr 5/6/2010 10:17'! initialize TheWorldMenu registerOpenCommand: (Array with: 'TextLint' with: (Array with: self with: #open))! ! !TLWizardGUI class methodsFor: 'instance creation' stamp: 'FabrizioPerin 4/21/2010 17:13'! open ^ self new open! ! !TLWizardGUI methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/4/2010 12:04'! actionsToPerform | sourcePathName rulesList textLintChecker results fileContents| sourcePathName := wizardInformations at: #sourceDirectoryPath. (TLCodeBrowser new codeBrowser) openOn: (FileDirectory on: sourcePathName) . progBar value: 5. "rulesList := wizardInformations at: #rules. rulesList isEmpty ifTrue:[DialogWindow new alert: 'Please select at least a rule'] ifFalse:[ textLintChecker := TLTextLintChecker new. rulesList do: [:ruleClassNameSymbol | textLintChecker addRule: ((Smalltalk at: ruleClassNameSymbol) perform: #new)]. progBar value: 3. fileContents := (StandardFileStream readOnlyFileNamed: sourcePathName) contentsOfEntireFile. fileContents := (fileContents copyReplaceAll: String cr with: String crlf) copyReplaceAll: String lf with: String crlf. results := textLintChecker check: fileContents. progBar value: 4. (TLCodeBrowser new codeBrowserFor: fileContents) openOn: results. progBar value: 5. ]." " results inspect."! ! !TLWizardGUI methodsFor: 'initialization' stamp: 'FabrizioPerin 5/4/2010 15:54'! buildWizardPanels | pane1 part1 | pane1 := TLWizardOnlyLastPane named: 'Select the directory containing Latex files'. part1 := TLChooseDirectoryPart new. pane1 addPart: part1 associatedTo: #sourceDirectoryPath. self addPane: pane1. ! ! !TLWizardGUI methodsFor: 'initialization' stamp: 'FabrizioPerin 4/7/2010 16:54'! initialize super initialize. self buildWizardPanels. ! ! !TLWizardGUI methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 4/21/2010 17:50'! performTerminateButtonAction "by default, just close the last current pane. Override this method if you want to create a subclass of WizardControl making a specific action" "^self subclassResponsibility" UIManager default displayProgress: 'Processing' at: Sensor cursorPoint from: 1 to: 5 during: [ :bar | progBar := bar. progBar value: 2. super performTerminateButtonAction . self actionsToPerform.].! ! TLWizardGUI initialize!