SystemOrganization addCategory: #'TextLint-View-Browser'! SystemOrganization addCategory: #'TextLint-View-Wizard'! Object subclass: #TLCodeBrowser instanceVariableNames: 'textLintChecker results' 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 5/21/2010 11:26'! codeBrowser | browser | browser := GLMTabulator new. browser title: 'TextLint Results Browser'. browser row: [ :r | r column: [:col | col row: #files; row: #refresh size: 29]; column: [:col | col row: #errors; row: #navigation size:29];"[:row | row column: #prev; column: #next] " column: #rationale]; row: #code. browser transmit to: #navigation; andShow: [ :a | a custom: (self navigationPane ) ]. self filesPaneOn: browser. self refreshPaneOn: browser. "self prevPaneOn: browser. self nextPaneOn: 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 sendTo: #errors->#selection from: #next->#nextElement with: [:x | x ]." "browser sendTo: #next->#errorGroup from: #errors ->#selectedPath with: [:x | self halt]; when: [:s | s notNil and: [ s isCollection not ]]." "browser sendTo: #prev->#currentElement from: #errors->#selectionPath. browser sendTo: #errors->#newPosition from: #next->#newElement. browser sendTo: #errors->#newPosition from: #next->#newElement." ^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: 'FabrizioPerin 5/21/2010 15:48'! errorsPaneOn: browser browser transmit to: #errors; from: #files; from: #outer -> #entity; andShow: [:a | a tree title: 'Errors'; display: [:file | | fileContents | 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, ' ', each element interval asString ] ] ]. "browser transmit to: #navigation->#entitySelected; from: #errors -> #selection; when:[:s | s notNil]." browser transmit to: #navigation->#pathSelected; from: #errors->#selectionPath. browser transmit to: #errors -> #selection; from: #selectedEl. ^browser! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 5/14/2010 10:29'! 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: 'initialization' stamp: 'FabrizioPerin 5/10/2010 13:14'! initializeWith: aStyle super initialize. textLintChecker := TLTextLintChecker new. aStyle rules do: [:rule | textLintChecker addRule: rule ].! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 5/21/2010 15:48'! navigationPane | nav nextElement | nextElement := nil. nav := GLMTabulator new. nav column: #prev; column: #next. nav transmit to: #next; andShow: [ :a | a actionList act: [:entity :selectedPathAndElement | | nextIndex selPath selEl | selPath := selectedPathAndElement at: 1. selEl := selectedPathAndElement at:2. nextIndex := ((selPath indexOf: selEl) + 1). ((selPath size < nextIndex) and: [ selEl isNil not and: [selEl isCollection not]]) ifTrue: [ nextElement := selPath at: nextIndex. nav transmit toOutside: #selectedEl; from: #next; transformed: [:el | nextElement].] ifFalse: [ nextElement := nil ] ] entitled: 'Next' ]. nav transmit to: #prev; andShow: [ :a | a actionList act: [:entity | (nav paneNamed: #errors) presentations do: [:pres | pres update] ] entitled: 'Prev']. nav transmit to: #next; fromOutside: #pathSelected. nav populate: #next->#select on: $m with: [:list :input | nextElement]. "nav transmit toOutside: #selectedEl; from: #next->#select." ^nav " a stackedArrangement. a tree title: 'Entities'; display: [ :all | all classes select: [ :each | each superclass = FM3 object ] ]; children: [ :c | children at: c name ifAbsent: [ OrderedCollection new ] ]; format: [ :each | self abstractFormattedNameOf: each ]; tags: [:each | each package isNil ifTrue: [#()] ifFalse: [each package name] ]; act: [ :list | list selection implementingClass browse ] entitled: 'Browse implementaton'; act: [ :list | list selection inspect ] entitled: 'Inspect' ]. " " aBrowser transmit to: #next; from: #errors->#selection; from: #errors->#selectionPath; andShowIfNone: [:a | a actionList act: [:entity :sel :selPath | | nextIndex | nextIndex := ((selPath indexOf: sel) + 1). ((selPath size < nextIndex) and: [ sel isNil not and: [sel isCollection not]]) ifTrue: [ aBrowser sendTo: #errors -> #selection from: #next -> #nextIndex with: [selPath at: nextIndex]. ] ] entitled: 'Next' ]. aBrowser transmit to: #prev; andShow: [ :a | a actionList act: [:entity | (aBrowser paneNamed: #errors) presentations do: [:pres | pres update] ] entitled: 'Prev']. ^aBrowser"! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 5/20/2010 17:26'! nextPaneOn: aBrowser aBrowser transmit to: #next; from: #errors->#selection; from: #errors->#selectionPath; andShowIfNone: [:a | a actionList act: [:entity :sel :selPath | | nextIndex | nextIndex := ((selPath indexOf: sel) + 1). ((selPath size < nextIndex) and: [ sel isNil not and: [sel isCollection not]]) ifTrue: [ " aBrowser transmit to: #next -> #nextIndex." "aBrowser transmit to: #errors -> #selection; from: #next->#nextIndex; with: [selPath at: nextIndex]." "a populate: #next->#nextIndex on: #i with: [selPath at: nextIndex]." "aBrowser announce: TLTestAnnuncer." "a populate: #next->#nextIndex on: #i with: [:i | self halt. selPath at: nextIndex]. " "aBrowser sendTo: #errors->#selection from:#next with: [self halt. p at: nextIndex]." aBrowser sendTo: #next -> #nextIndex from: #next with: [selPath at: nextIndex]. "(aBrowser paneNamed: #errors) populate: #selection on: #u with: [p at: nextIndex]." "entity populate: #selection on: #u with: [p at: nextIndex]." ] ] entitled: 'Next' ]. ^aBrowser! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'FabrizioPerin 5/14/2010 20:54'! prevPaneOn: aBrowser aBrowser transmit to: #prev; andShow: [ :a | a actionList act: [:entity | (aBrowser paneNamed: #errors) presentations do: [:pres | pres update] ] entitled: 'Prev']. ^aBrowser! ! !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/14/2010 11:32'! refreshPaneOn: aBrowser aBrowser transmit to: #refresh; andShow: [ :a | a actionList act: [:entity | (aBrowser paneNamed: #errors) presentations do: [:pres | pres update]. (aBrowser paneNamed: #code) presentations do: [:pres | pres update]. ] entitled: 'Refresh']. ^aBrowser! ! 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}.! ! 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! ! Announcer subclass: #TLTestAnnuncer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Browser'! 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/10/2010 13:38'! actionsToPerform | sourcePathName styleNamesList writingStyle | sourcePathName := wizardInformations at: #sourceDirectoryPath. styleNamesList := wizardInformations at: #style. writingStyle := nil. styleNamesList do: [:style | style = 'Computer Science Paper Style' ifTrue: [writingStyle := TLWritingStyle computerSciencePaperStyle ]]. progBar value: 4. writingStyle isNil ifTrue:[DialogWindow new alert: 'Please select a style'] ifFalse: [ (TLCodeBrowser newFor: writingStyle ) 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/10/2010 13:22'! buildWizardPanels | pane1 part1 pane2 part2 | pane1 := WizardFirstPane named: 'Select the directory containing Latex files'. pane2 := WizardLastPane named: 'Select the paper style'. part1 := TLChooseDirectoryPart new. pane1 addPart: part1 associatedTo: #sourceDirectoryPath. part2 := TLMultiCheckboxesPart groupName: 'Styles' withAll: (OrderedCollection with: (TLWritingStyle computerSciencePaperStyle name)). pane2 addPart: part2 associatedTo: #style. self addPane: pane1. self addPane: pane2. ! ! !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!