SystemOrganization addCategory: #'TextLint-View-Browser'! SystemOrganization addCategory: #'TextLint-View-Wizard'! Object subclass: #TLCodeBrowser instanceVariableNames: 'textLintChecker results saveAnnouncer' 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 6/8/2010 11:10'! codeBrowser | browser | browser := GLMTabulator new. browser title: 'TextLint Results Browser'. browser row: [ :row | row column: #files; column: [ :col | col row: #errors span: 3; row: #rationale ] span: 3 ]; row: #code. self filesPaneOn: 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: 'FabrizioPerin 6/8/2010 11:14'! codePaneOn: browser browser transmit to: #code; from: #files; andShow: [:a | a text title: [:file | file ]; display: [:file | | text | 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 ]. ^browser! ! !TLCodeBrowser methodsFor: 'Glamour' stamp: 'JorgeRessia 6/16/2010 15:25'! errorsPaneOn: browser | fileContents | browser transmit to: #errors; from: #files; andShow: [ :a | a tree title: 'Errors'; display: [ :file | Cursor wait showWhile: [ | stream | stream := MultiByteFileStream new open: file forWrite: false. fileContents := [ stream basicNext: stream size ]"used directly basicNext otherwise using contentsOfEntireFile we got some problems in the UTF8 conversion" ensure: [ stream close ]. 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: [ String streamContents: [ :stream | stream nextPutAll: (each element processFor: self)] ] ]; updateOn: TLFileSaved from: saveAnnouncer ]. ^ browser! ! !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 6/5/2010 10:34'! initialize super initialize. self initializeWith: TLWritingStyle computerSciencePaperStyle. saveAnnouncer := Announcer new.! ! !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:10'! 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 15:41'! processSentence: aSentence | aStream | ^String streamContents: [ :stream | 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! ! Announcement subclass: #TLFileSaved instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Browser'! !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 ! ! WizardLastPane subclass: #TLWizardLastPane instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-View-Wizard'! !TLWizardLastPane methodsFor: 'as yet unclassified' stamp: 'FabrizioPerin 5/25/2010 15:34'! newTerminateButton ^ self newButtonNamed: 'OK' withAction: #terminateButtonAction.! ! TLWizardLastPane 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}.! ! 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: 'initialization' stamp: 'FabrizioPerin 5/30/2010 18:15'! menuCommandOn: aBuilder (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 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: 'lr 6/10/2010 16:56'! buildWizardPanels | pane1 part1 pane2 part2 | pane1 := WizardFirstPane named: 'Select the directory'. pane2 := TLWizardLastPane named: 'Select the 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.].! ! !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 ! ! 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! ! !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! ! TLWizardGUI initialize!