Smalltalk createPackage: 'IDE'! (Smalltalk packageAt: 'IDE' ifAbsent: [ self error: 'Package not created: IDE' ]) imports: {'codeMirrorLib' -> 'codemirror/lib/codemirror'. 'amber/core/Platform-Services'. 'amber/web/Web-JQuery'. 'codemirror/addon/hint/show-hint'. 'codemirror/mode/smalltalk/smalltalk'. 'css!!./resources/amber'. 'css!!codemirror/addon/hint/show-hint'. 'css!!codemirror/lib/codemirror'. 'css!!codemirror/theme/ambiance'. 'jquery-ui'}! Widget subclass: #ClassesList slots: {#browser. #ul. #nodes} package: 'IDE'! !ClassesList methodsFor: 'accessing'! browser ^ browser ! browser: aBrowser browser := aBrowser ! category ^ self browser selectedPackage ! getNodes ^ ClassBuilder sortClasses: self browser classes ! nodes nodes ifNil: [ nodes := self getNodes ]. ^ nodes ! resetNodes nodes := nil ! ! !ClassesList methodsFor: 'rendering'! labelOf: aClass level: anInteger ^ String streamContents: [ :str | anInteger timesRepeat: [ str nextPutAll: '    ' ]. str nextPutAll: aClass name ] ! renderNode: aClassAndSubclasses level: anInteger on: html | cssClass aClass | cssClass := ''. aClass := aClassAndSubclasses first. self browser selectedClass = aClass ifTrue: [ cssClass := cssClass, ' selected' ]. aClass comment ifNotEmpty: [ cssClass := cssClass, ' commented' ]. html li class: cssClass; onClick: [ self browser selectClass: aClass ]; in: [ :li | li asJQuery html: (self labelOf: aClass level: anInteger) ]. self renderNodes: aClassAndSubclasses second level: anInteger + 1 on: html ! renderNodes: aCollection level: anInteger on: html aCollection do: [ :each | self renderNode: each level: anInteger on: html ] ! renderOn: html ul := html ul class: 'amber_column browser classes'; yourself. self updateNodes ! updateNodes ul contents: [ :html | self renderNodes: self nodes level: 0 on: html ] ! ! !ClassesList class methodsFor: 'instance creation'! on: aBrowser ^ self new browser: aBrowser; yourself ! ! Object subclass: #DebugErrorHandler slots: {} package: 'IDE'! !DebugErrorHandler methodsFor: 'error handling'! handleError: anError [ anError context ifNil: [ anError context: thisContext ]. Debugger new error: anError; open ] on: Error do: [ :error | ConsoleErrorHandler new handleError: error ] ! ! !DebugErrorHandler class methodsFor: 'initialization'! initialize ErrorHandler register: self new ! ! Widget subclass: #ProgressBar slots: {#percent. #progressDiv. #div} package: 'IDE'! !ProgressBar methodsFor: 'accessing'! percent ^ percent ifNil: [ 0 ] ! percent: aNumber percent := aNumber ! ! !ProgressBar methodsFor: 'rendering'! renderOn: html div := html div class: 'progress_bar'; yourself. self renderProgressBar ! renderProgressBar div contents: [ :html | html div class: 'progress'; style: 'width:', self percent asString, '%' ] ! ! !ProgressBar methodsFor: 'updating'! updatePercent: aNumber self percent: aNumber. self renderProgressBar ! ! Widget subclass: #SourceArea slots: {#editor. #div. #receiver. #onDoIt} package: 'IDE'! !SourceArea methodsFor: 'accessing'! currentLine ^ editor getLine: (editor getCursor line) ! currentLineOrSelection ^ editor somethingSelected ifFalse: [ self currentLine ] ifTrue: [ self selection ] ! editor ^ editor ! onDoIt ^ onDoIt ! onDoIt: aBlock onDoIt := aBlock ! receiver ^ receiver ifNil: [ DoIt new ] ! receiver: anObject receiver := anObject ! selection ^ editor getSelection ! setEditorOn: aTextarea editor := codeMirrorLib provided fromTextArea: aTextarea options: #{ #theme -> ('ide.codeMirrorTheme' settingValueIfAbsent: 'default'). #mode -> 'text/x-stsrc'. #lineNumbers -> true. #enterMode -> 'flat'. #indentWithTabs -> true. #indentUnit -> 4. #matchBrackets -> true. #electricChars -> false } ! val ^ editor getValue ! val: aString editor setValue: aString ! ! !SourceArea methodsFor: 'actions'! clear self val: '' ! doIt | result | result := self eval: self currentLineOrSelection. self onDoIt ifNotNil: [ self onDoIt value ]. ^ result ! eval: aString | compiler | compiler := Compiler new. [ compiler parseExpression: aString ] on: Error do: [ :ex | ^ Terminal alert: ex messageText ]. ^ compiler evaluateExpression: aString on: self receiver ! fileIn Importer new import: self currentLineOrSelection readStream ! focus self editor focus. ! handleKeyDown: anEvent ! inspectIt self doIt inspect ! print: aString | start stop currentLine | currentLine := (editor getCursor: false) line. start := HashedCollection new. start at: 'line' put: currentLine. start at: 'ch' put: (editor getCursor: false) ch. (editor getSelection) ifEmpty: [ "select current line if selection is empty" start at: 'ch' put: (editor getLine: currentLine) size. editor setSelection: #{'line' -> currentLine. 'ch' -> 0} end: start. ]. stop := HashedCollection new. stop at: 'line' put: currentLine. stop at: 'ch' put: ((start at: 'ch') + aString size + 2). editor replaceSelection: (editor getSelection, ' ', aString, ' '). editor setCursor: (editor getCursor: true). editor setSelection: stop end: start ! printIt self print: self doIt printString. self focus. ! ! !SourceArea methodsFor: 'events'! onKeyDown: aBlock div onKeyDown: aBlock ! onKeyUp: aBlock div onKeyUp: aBlock ! ! !SourceArea methodsFor: 'rendering'! renderOn: html | textarea | div := html div class: 'source'. div with: [ textarea := html textarea ]. self setEditorOn: textarea asDomNode. div onKeyDown: [ :e | self handleKeyDown: e ] ! ! !SourceArea class methodsFor: 'initialization'! initialize super initialize. self setupCodeMirror ! setupCodeMirror ! ! Widget subclass: #TabManager slots: {#selectedTab. #tabs. #opened. #ul. #input} package: 'IDE'! !TabManager methodsFor: 'accessing'! labelFor: aWidget | label maxSize | maxSize := 15. label := aWidget label copyFrom: 0 to: (aWidget label size min: maxSize). aWidget label size > maxSize ifTrue: [ label := label, '...' ]. ^ label ! tabs ^ tabs ifNil: [ tabs := Array new ] ! ! !TabManager methodsFor: 'actions'! close opened ifTrue: [ '#amber' asJQuery hide. ul asJQuery hide. selectedTab hide. self removeBodyMargin. 'body' asJQuery removeClass: 'amberBody'. opened := false ] ! closeTab: aWidget self removeTab: aWidget. self selectTab: self tabs last. aWidget remove. self update ! newBrowserTab Browser open ! onResize: aBlock '#amber' asJQuery resizable: #{ 'handles' -> 'n'. 'resize' -> aBlock. 'minHeight' -> 230 } ! onWindowResize: aBlock window asJQuery resize: aBlock ! open opened ifFalse: [ 'body' asJQuery addClass: 'amberBody'. '#amber' asJQuery show. ul asJQuery show. self updateBodyMargin. selectedTab show. opened := true ] ! removeBodyMargin self setBodyMargin: 0 ! search: aString | searchedClass | searchedClass := Smalltalk globals at: aString. searchedClass isClass ifTrue: [ Browser openOn: searchedClass ] ifFalse: [ ReferencesBrowser search: aString ] ! selectTab: aWidget (self tabs includes: aWidget) ifFalse: [ ^ self ]. self open. selectedTab := aWidget. self tabs do: [ :each | each hide ]. aWidget show. self update ! setBodyMargin: anInteger '.amberBody' asJQuery css: 'margin-bottom' put: anInteger asString, 'px' ! updateBodyMargin self setBodyMargin: '#amber' asJQuery height ! updatePosition '#amber' asJQuery css: 'top' put: ''; css: 'bottom' put: '0px' ! ! !TabManager methodsFor: 'adding/Removing'! addTab: aWidget self tabs add: aWidget. aWidget appendToJQuery: '#amber' asJQuery. aWidget hide ! removeTab: aWidget self tabs remove: aWidget. self update ! ! !TabManager methodsFor: 'initialization'! initialize super initialize. Inspector register: IDEInspector. opened := true. [ :html | html div id: 'amber' ] appendToJQuery: 'body' asJQuery. 'body' asJQuery addClass: 'amberBody'. self appendToJQuery: '#amber' asJQuery. self addTab: IDETranscript current; addTab: Workspace new; addTab: TestRunner new. self selectTab: self tabs last. self onResize: [ self updateBodyMargin; updatePosition ]; onWindowResize: [ self updatePosition ] ! ! !TabManager methodsFor: 'rendering'! renderOn: html html div id: 'logo'. self renderToolbarOn: html. ul := html ul id: 'amberTabs'; yourself. self renderTabs ! renderTabFor: aWidget on: html | li | li := html li. selectedTab = aWidget ifTrue: [ li class: 'selected' ]. li with: [ html span class: 'ltab'. html span class: 'mtab'; with: [ aWidget canBeClosed ifTrue: [ html span class: 'close'; with: 'x'; onClick: [ self closeTab: aWidget ]]. html span with: (self labelFor: aWidget) ]. html span class: 'rtab' ]; onClick: [ self selectTab: aWidget ] ! renderTabs ul contents: [ :html | self tabs do: [ :each | self renderTabFor: each on: html ]. html li class: 'newtab'; with: [ html span class: 'ltab'. html span class: 'mtab'; with: ' + '. html span class: 'rtab' ]; onClick: [ self newBrowserTab ]] ! renderToolbarOn: html html div id: 'amber_toolbar'; with: [ input := html input class: 'implementors'; yourself. input onKeyPress: [ :event | event keyCode = 13 ifTrue: [ self search: input asJQuery val ]]. html div id: 'amber_close'; onClick: [ self close ]] ! ! !TabManager methodsFor: 'updating'! update self renderTabs ! ! TabManager class slots: {#current}! !TabManager class methodsFor: 'actions'! toggleAmberIDE '#amber' asJQuery length = 0 ifTrue: [ Browser open ] ifFalse: [ ('#amber' asJQuery is: ':visible') ifTrue: [ TabManager current close ] ifFalse: [ TabManager current open ] ] ! ! !TabManager class methodsFor: 'instance creation'! current ^ current ifNil: [ current := super new ] ! new self shouldNotImplement ! ! Widget subclass: #TabWidget slots: {#div} package: 'IDE'! !TabWidget methodsFor: 'accessing'! label self subclassResponsibility ! ! !TabWidget methodsFor: 'actions'! close TabManager current closeTab: self ! hide div asJQuery hide ! open TabManager current addTab: self. TabManager current selectTab: self ! remove div asJQuery remove ! show div asJQuery show ! ! !TabWidget methodsFor: 'rendering'! renderBoxOn: html ! renderButtonsOn: html ! renderOn: html div := html div class: 'amberTool'; yourself. self renderTab ! renderTab div contents: [ :html | html div class: 'amber_box'; with: [ self renderBoxOn: html ]. html div class: 'amber_buttons'; with: [ self renderButtonsOn: html ]] ! update self renderTab ! ! !TabWidget methodsFor: 'testing'! canBeClosed ^ false ! ! !TabWidget class methodsFor: 'instance creation'! open ^ self new open ! ! TabWidget subclass: #Browser slots: {#selectedPackage. #selectedClass. #selectedProtocol. #selectedMethod. #packagesList. #classesList. #protocolsList. #methodsList. #sourceArea. #tabsList. #selectedTab. #saveButton. #classButtons. #methodButtons. #unsavedChanges} package: 'IDE'! !Browser methodsFor: 'accessing'! classCommentSource ^ selectedClass comment ! classDeclarationTemplate ^ 'Object subclass: #NameOfSubclass instanceVariableNames: '''' package: ''', self selectedPackage, '''' ! classes ^ ((Smalltalk classes select: [ :each | each category = selectedPackage ]) sort: [ :a :b | a name < b name ]) asSet ! declarationSource | klass | klass := self selectedClassOrMetaClass. ^ klass ifNotNil: [ klass definition ] ifNil: [ selectedTab = #instance ifTrue: [ self classDeclarationTemplate ] ifFalse: [ '' ] ] ! dummyMethodSource ^ 'messageSelectorAndArgumentNames "comment stating purpose of message" | temporary variable names | statements' ! label ^ selectedClass ifNil: [ 'Browser (nil)' ] ifNotNil: [ 'Browser: ', selectedClass name ] ! methodSource ^ selectedMethod ifNil: [ self dummyMethodSource ] ifNotNil: [ selectedMethod source ] ! methods | klass | selectedTab = #comment ifTrue: [ ^ #() ]. klass := self selectedClassOrMetaClass. ^ (selectedProtocol ifNil: [ klass ifNil: [ #() ] ifNotNil: [ klass methodDictionary values ]] ifNotNil: [ klass methodsInProtocol: selectedProtocol ]) sort: [ :a :b | a selector < b selector ] ! packages | packages | packages := Array new. Smalltalk classes do: [ :each | (packages includes: each category) ifFalse: [ packages add: each category ]]. ^ packages sort ! protocols | klass | selectedClass ifNil: [ ^ #() ]. selectedTab = #comment ifTrue: [ ^ #() ]. klass := self selectedClassOrMetaClass. klass ifNil: [ ^ #() ]. klass methodDictionary ifEmpty: [ ^ {'not yet classified'} ]. ^ klass protocols ! selectedClass ^ selectedClass ! selectedClassOrMetaClass ^ selectedClass ifNotNil: [ selectedTab = #instance ifTrue: [ selectedClass ] ifFalse: [ selectedClass theMetaClass ] ] ! selectedPackage ^ selectedPackage ! source selectedTab = #comment ifFalse: [ ^ (selectedProtocol notNil or: [ selectedMethod notNil ]) ifFalse: [ self declarationSource ] ifTrue: [ self methodSource ]]. ^ selectedClass ifNil: [ '' ] ifNotNil: [ self classCommentSource ] ! ! !Browser methodsFor: 'actions'! addNewClass | className | className := Terminal prompt: 'New class'. (className notNil and: [ className notEmpty ]) ifTrue: [ Object subclass: className instanceVariableNames: '' package: self selectedPackage. self resetClassesList; updateClassesList. self selectClass: (Smalltalk globals at: className) ] ! addNewProtocol | newProtocol | newProtocol := Terminal prompt: 'New method protocol'. (newProtocol notNil and: [ newProtocol notEmpty ]) ifTrue: [ selectedMethod protocol: newProtocol. self setMethodProtocol: newProtocol ] ! cancelChanges ^ unsavedChanges ifTrue: [ Terminal confirm: 'Cancel changes?' ] ifFalse: [ true ] ! commitPackage selectedPackage ifNotNil: [ (Package named: selectedPackage) commit ] ! compile | currentEditLine | self disableSaveButton. currentEditLine := sourceArea editor getCursor. selectedTab = #comment ifTrue: [ selectedClass ifNotNil: [ self compileClassComment ]] ifFalse: [ (selectedProtocol notNil or: [ selectedMethod notNil ]) ifFalse: [ self compileDefinition ] ifTrue: [ self compileMethodDefinition ]]. sourceArea editor setCursor: currentEditLine. ! compileClassComment selectedClass comment: sourceArea val ! compileDefinition | newClass | newClass := Compiler new evaluateExpression: sourceArea val. self resetClassesList; updateCategoriesList; updateClassesList. self selectClass: newClass ! compileMethodDefinition self compileMethodDefinitionFor: self selectedClassOrMetaClass ! compileMethodDefinitionFor: aClass | compiler package method compiledSource source node | source := sourceArea val. selectedProtocol ifNil: [ selectedProtocol := selectedMethod protocol ]. [[ method := Compiler new install: source forClass: aClass protocol: selectedProtocol ] on: ParseError do: [ :e | ^ Terminal alert: 'PARSE ERROR: ', e messageText ]] on: UnknownVariableError do: [ :e | "Do not try to redeclare javascript's objects" (Platform includesGlobal: e variableName) ifFalse: [ (Terminal confirm: 'Declare ''', e variableName, ''' as instance variable?') ifFalse: [ ^ nil ] ifTrue: [ Environment new addInstVarNamed: e variableName to: aClass. ^ self compileMethodDefinitionFor: aClass ] ] ]. self updateMethodsList. self selectMethod: method ! copyClass | className | className := Terminal prompt: 'Copy class'. (className notNil and: [ className notEmpty ]) ifTrue: [ ClassBuilder new copyClass: self selectedClass named: className. self resetClassesList; updateClassesList. self selectClass: (Smalltalk globals at: className) ] ! disableSaveButton saveButton ifNotNil: [ saveButton at: 'disabled' put: true ]. unsavedChanges := false ! handleSourceAreaKeyDown: anEvent ! hideClassButtons classButtons asJQuery hide ! hideMethodButtons methodButtons asJQuery hide ! removeClass (Terminal confirm: 'Do you really want to remove ', selectedClass name, '?') ifTrue: [ Smalltalk removeClass: selectedClass. self resetClassesList. self selectClass: nil ] ! removeMethod self cancelChanges ifTrue: [ (Terminal confirm: 'Do you really want to remove #', selectedMethod selector, '?') ifTrue: [ self selectedClassOrMetaClass removeCompiledMethod: selectedMethod. self selectMethod: nil ]] ! removePackage (Terminal confirm: 'Do you really want to remove the whole package ', selectedPackage, ' with all its classes?') ifTrue: [ Smalltalk removePackage: selectedPackage. self updateCategoriesList ] ! renameClass | newName | newName := Terminal prompt: 'Rename class ', selectedClass name. (newName notNil and: [ newName notEmpty ]) ifTrue: [ selectedClass rename: newName. self updateClassesList; updateSourceAndButtons ] ! renamePackage | newName | newName := Terminal prompt: 'Rename package ', selectedPackage. newName ifNotNil: [ newName ifNotEmpty: [ Smalltalk renamePackage: selectedPackage to: newName. self updateCategoriesList ]] ! search: aString self cancelChanges ifTrue: [ | searchedClass | searchedClass := Smalltalk globals at: aString. searchedClass isClass ifTrue: [ self class openOn: searchedClass ] ifFalse: [ self searchReferencesOf: aString ]] ! searchClassReferences ReferencesBrowser search: selectedClass name ! searchReferencesOf: aString ReferencesBrowser search: aString ! selectCategory: aCategory self cancelChanges ifTrue: [ selectedPackage := aCategory. selectedClass := selectedProtocol := selectedMethod := nil. self resetClassesList. self updateCategoriesList; updateClassesList; updateProtocolsList; updateMethodsList; updateSourceAndButtons ] ! selectClass: aClass self cancelChanges ifTrue: [ selectedClass := aClass. selectedProtocol := selectedMethod := nil. self updateClassesList; updateProtocolsList; updateMethodsList; updateSourceAndButtons ] ! selectMethod: aMethod self cancelChanges ifTrue: [ selectedMethod := aMethod. self updateProtocolsList; updateMethodsList; updateSourceAndButtons ] ! selectProtocol: aString self cancelChanges ifTrue: [ selectedProtocol := aString. selectedMethod := nil. self updateProtocolsList; updateMethodsList; updateSourceAndButtons ] ! selectTab: aString self cancelChanges ifTrue: [ selectedTab := aString. self selectProtocol: nil. self updateTabsList ] ! setMethodProtocol: aString | klass | klass := self selectedClassOrMetaClass. self cancelChanges ifTrue: [ selectedMethod origin = klass ifFalse: [ Terminal alert: 'Method is from trait composition.' ] ifTrue: [ (self protocols includes: aString) ifFalse: [ self addNewProtocol ] ifTrue: [ selectedMethod protocol: aString. klass compile: selectedMethod source protocol: aString. selectedProtocol := aString. self updateProtocolsList; updateMethodsList; updateSourceAndButtons ]]] ! showClassButtons classButtons asJQuery show ! showMethodButtons methodButtons asJQuery show ! ! !Browser methodsFor: 'initialization'! initialize super initialize. selectedTab := #instance. selectedPackage := self packages first. unsavedChanges := false ! ! !Browser methodsFor: 'rendering'! renderBottomPanelOn: html html div class: 'amber_sourceCode'; with: [ sourceArea := SourceArea new. sourceArea renderOn: html. sourceArea onKeyDown: [ :e | self handleSourceAreaKeyDown: e ]. sourceArea onKeyUp: [ self updateStatus ]] ! renderBoxOn: html self renderTopPanelOn: html; renderTabsOn: html; renderBottomPanelOn: html ! renderButtonsOn: html saveButton := html button. saveButton with: 'Save'; onClick: [ self compile ]. methodButtons := html span. classButtons := html span. html div class: 'right'; with: [ html button with: 'DoIt'; onClick: [ sourceArea doIt ]. html button with: 'PrintIt'; onClick: [ sourceArea printIt ]. html button with: 'InspectIt'; onClick: [ sourceArea inspectIt ]]. self updateSourceAndButtons ! renderTabsOn: html tabsList := html ul class: 'amber_tabs amber_browser'. self updateTabsList. ! renderTopPanelOn: html html div class: 'top'; with: [ packagesList := html ul class: 'amber_column browser packages'. html div class: 'amber_packagesButtons'; with: [ html button title: 'Commit classes in this package to disk'; onClick: [ self commitPackage ]; with: 'Commit'. html button title: 'Rename package'; onClick: [ self renamePackage ]; with: 'Rename'. html button title: 'Remove this package from the system'; onClick: [ self removePackage ]; with: 'Remove' ]. classesList := ClassesList on: self. classesList renderOn: html. protocolsList := html ul class: 'amber_column browser protocols'. methodsList := html ul class: 'amber_column browser methods'. self updateCategoriesList; updateClassesList; updateProtocolsList; updateMethodsList. html div class: 'amber_clear' ] ! ! !Browser methodsFor: 'testing'! canBeClosed ^ true ! ! !Browser methodsFor: 'updating'! resetClassesList classesList resetNodes ! updateCategoriesList packagesList contents: [ :html | self packages do: [ :each || li label | label := each ifEmpty: [ 'Unclassified' ]. li := html li. selectedPackage = each ifTrue: [ li class: 'selected' ]. li with: label; onClick: [ self selectCategory: each ]] ] ! updateClassesList TabManager current update. classesList updateNodes ! updateMethodsList methodsList contents: [ :html | self methods do: [ :each || li | li := html li. selectedMethod = each ifTrue: [ li class: 'selected' ]. li with: each selector; with: (each origin = self selectedClassOrMetaClass ifTrue: [''] ifFalse: [ ' (', each origin name, ')' ]); onClick: [ self selectMethod: each ]] ] ! updateProtocolsList protocolsList contents: [ :html | self protocols do: [ :each || li | li := html li. selectedProtocol = each ifTrue: [ li class: 'selected' ]. li with: each; onClick: [ self selectProtocol: each ]] ] ! updateSourceAndButtons | currentProtocol | self disableSaveButton. classButtons contents: [ :html | html button title: 'Create a new class'; onClick: [ self addNewClass ]; with: 'New class'. html button with: 'Rename class'; onClick: [ self renameClass ]. html button with: 'Copy class'; onClick: [ self copyClass ]. html button with: 'Remove class'; onClick: [ self removeClass ]. html button with: 'References'; onClick: [ self searchClassReferences ]]. methodButtons contents: [ :html | | protocolSelect referencesSelect | html button with: 'Remove method'; onClick: [ self removeMethod ]. protocolSelect := html select. protocolSelect onChange: [ self setMethodProtocol: protocolSelect asJQuery val ]; with: [ html option with: 'Method protocol'; at: 'disabled' put: 'disabled'. html option class: 'important'; with: 'New...'. currentProtocol := selectedProtocol. (currentProtocol isNil and: [ selectedMethod notNil ]) ifTrue: [ currentProtocol := selectedMethod category ]. self protocols do: [ :each | | option | option := html option with: each. currentProtocol = each ifTrue: [ option at: 'selected' put: 'selected' ] ] ]. selectedMethod isNil ifFalse: [ referencesSelect := html select. referencesSelect onChange: [ self searchReferencesOf: referencesSelect asJQuery val ]; with: [ |option| html option with: 'References'; at: 'disabled' put: 'disabled'; at: 'selected' put: 'selected'. html option class: 'important'; with: selectedMethod selector. selectedMethod messageSends sorted do: [ :each | html option with: each ]] ]]. selectedMethod isNil ifTrue: [ self hideMethodButtons. (selectedClass isNil or: [ selectedProtocol notNil ]) ifTrue: [ self hideClassButtons ] ifFalse: [ self showClassButtons ]] ifFalse: [ self hideClassButtons. self showMethodButtons ]. sourceArea val: self source ! updateStatus sourceArea val = self source ifTrue: [ saveButton ifNotNil: [ saveButton at: 'disabled' put: true ]. unsavedChanges := false ] ifFalse: [ saveButton ifNotNil: [ saveButton removeAt: 'disabled' ]. unsavedChanges := true ] ! updateTabsList tabsList contents: [ :html || li | li := html li. selectedTab = #instance ifTrue: [ li class: 'selected' ]. li with: [ html span class: 'ltab'. html span class: 'mtab'; with: 'Instance'. html span class: 'rtab' ]; onClick: [ self selectTab: #instance ]. li := html li. selectedTab = #class ifTrue: [ li class: 'selected' ]. li with: [ html span class: 'ltab'. html span class: 'mtab'; with: 'Class'. html span class: 'rtab' ]; onClick: [ self selectTab: #class ]. li := html li. selectedTab = #comment ifTrue: [ li class: 'selected' ]. li with: [ html span class: 'ltab'. html span class: 'mtab'; with: 'Comment'. html span class: 'rtab' ]; onClick: [ self selectTab: #comment ]] ! ! !Browser class methodsFor: 'convenience'! open self new open ! openOn: aClass ^ self new open; selectCategory: aClass category; selectClass: aClass ! ! TabWidget subclass: #Debugger slots: {#error. #selectedContext. #sourceArea. #ul. #ul2. #inspector. #saveButton. #unsavedChanges. #selectedVariable. #selectedVariableName. #inspectButton} package: 'IDE'! !Debugger methodsFor: 'accessing'! allVariables | all | all := Dictionary new. self receiver class allInstanceVariableNames do: [ :each | all at: each put: (self receiver instVarNamed: each) ]. selectedContext locals keysAndValuesDo: [ :key :value | all at: key put: value ]. ^ all ! error ^ error ! error: anError error := anError ! label ^ '[ Debugger ]' ! method ^ selectedContext method ! receiver ^ selectedContext receiver ! source ^ self method ifNil: [ 'Method doesn''t exist!!' ] ifNotNil: [ self method source ] ! ! !Debugger methodsFor: 'actions'! inspectSelectedVariable selectedVariable inspect ! proceed self close. selectedContext receiver perform: selectedContext selector withArguments: selectedContext locals ! save | protocol | protocol := (selectedContext receiver class methodDictionary at: selectedContext selector) category. selectedContext receiver class compile: sourceArea val protocol: protocol. self updateStatus ! selectContext: aContext selectedContext := aContext. selectedVariable := nil. selectedVariableName := nil. self updateContextsList; updateSourceArea; updateInspector; updateVariablesList; updateStatus ! selectVariable: anObject named: aString selectedVariable := anObject. selectedVariableName := aString. inspector contents: [ :html | html with: anObject printString ]. self updateVariablesList ! ! !Debugger methodsFor: 'initialization'! initialize super initialize. unsavedChanges = false ! ! !Debugger methodsFor: 'rendering'! renderBottomPanelOn: html html div class: 'amber_sourceCode debugger'; with: [ sourceArea := SourceArea new. sourceArea renderOn: html ]. ul2 := html ul class: 'amber_column debugger variables'. inspector := html div class: 'amber_column debugger inspector'. sourceArea onKeyUp: [ self updateStatus ] ! renderBoxOn: html self renderTopPanelOn: html; renderBottomPanelOn: html ! renderButtonsOn: html saveButton := html button with: 'Save'; onClick: [ self save ]. html button with: 'DoIt'; onClick: [ sourceArea doIt ]. html button with: 'PrintIt'; onClick: [ sourceArea printIt ]. html button with: 'InspectIt'; onClick: [ sourceArea inspectIt ]. html button with: 'Proceed'; onClick: [ self proceed ]. html button with: 'Abandon'; onClick: [ self close ]. inspectButton := html button class: 'amber_button debugger inspect'; with: 'Inspect'; onClick: [ self inspectSelectedVariable ]. self updateSourceArea; updateStatus; updateVariablesList; updateInspector ! renderContext: aContext on: html | li context | context := aContext. [ context notNil ] whileTrue: [ li := html li. selectedContext = context ifTrue: [ li class: 'selected' ]. li with: context asString; onClick: (context in: [:ctx | [ self selectContext: ctx ]]). context := context outerContext ] ! renderTopPanelOn: html selectedContext := self error context. html div class: 'top'; with: [ html div class: 'label'; with: self error messageText. ul := html ul class: 'amber_column debugger contexts'; with: [ self renderContext: self error context on: html ]] ! ! !Debugger methodsFor: 'testing'! canBeClosed ^ true ! ! !Debugger methodsFor: 'updating'! updateContextsList ul contents: [ :html | self renderContext: self error context on: html ] ! updateInspector inspector contents: [ :html | ] ! updateSourceArea sourceArea val: self source ! updateStatus sourceArea val = self source ifTrue: [ saveButton ifNotNil: [ saveButton at: 'disabled' put: true ]. unsavedChanges := false ] ifFalse: [ saveButton ifNotNil: [ saveButton removeAt: 'disabled' ]. unsavedChanges := true ] ! updateVariablesList ul2 contents: [ :html | | li | li := html li with: 'self'; onClick: [ self selectVariable: self receiver named: 'self' ]. selectedVariableName = 'self' ifTrue: [ li class: 'selected' ]. self allVariables keysAndValuesDo: [ :key :value | li := html li with: key; onClick: [ self selectVariable: value named: key ]. selectedVariableName = key ifTrue: [ li class: 'selected' ] ] ]. selectedVariable ifNil: [ inspectButton at: 'disabled' put: true ] ifNotNil: [ inspectButton removeAt: 'disabled' ] ! ! TabWidget subclass: #IDEInspector slots: {#label. #variables. #object. #selectedVariable. #variablesList. #valueTextarea. #diveButton. #sourceArea} package: 'IDE'! !IDEInspector methodsFor: 'accessing'! label ^ label ifNil: [ 'Inspector (nil)' ] ! selectedVariable ^ selectedVariable ! selectedVariable: aString selectedVariable := aString ! selectedVariableValue ^ (self variables detect: [ :each | each key = self selectedVariable ]) value ! setLabel: aString label := aString ! setVariables: aCollection variables := (aCollection respondsTo: #associations) ifTrue: [ aCollection associations ] ifFalse: [ aCollection ] ! sourceArea ^ sourceArea ! variables ^ variables ! ! !IDEInspector methodsFor: 'actions'! dive self selectedVariableValue inspect ! inspect: anObject object := anObject. variables := #(). object inspectOn: self ! refresh self inspect: object; updateVariablesList; updateValueTextarea ! ! !IDEInspector methodsFor: 'rendering'! renderBottomPanelOn: html html div class: 'amber_sourceCode'; with: [ sourceArea := SourceArea new receiver: object; onDoIt: [ self refresh ]; yourself. sourceArea renderOn: html ] ! renderBoxOn: html self renderTopPanelOn: html; renderBottomPanelOn: html ! renderButtonsOn: html html button with: 'DoIt'; onClick: [ self sourceArea doIt ]. html button with: 'PrintIt'; onClick: [ self sourceArea printIt ]. html button with: 'InspectIt'; onClick: [ self sourceArea inspectIt ]. self updateButtons ! renderTopPanelOn: html html div class: 'top'; with: [ variablesList := html ul class: 'amber_column variables'. valueTextarea := html textarea class: 'amber_column value'; at: 'readonly' put: 'readonly'; yourself. html div class: 'amber_tabs inspector'; with: [ html button class: 'amber_button inspector refresh'; with: 'Refresh'; onClick: [ self refresh ]. diveButton := html button class: 'amber_button inspector dive'; with: 'Dive'; onClick: [ self dive ]]. html div class: 'amber_clear' ]. self updateVariablesList; updateValueTextarea. ! ! !IDEInspector methodsFor: 'testing'! canBeClosed ^ true ! ! !IDEInspector methodsFor: 'updating'! selectVariable: aString self selectedVariable: aString. self updateVariablesList; updateValueTextarea; updateButtons ! updateButtons (self selectedVariable notNil and: [ self selectedVariableValue notNil ]) ifFalse: [ diveButton at: 'disabled' put: true ] ifTrue: [ diveButton removeAt: 'disabled' ] ! updateValueTextarea valueTextarea asJQuery val: (self selectedVariable isNil ifTrue: [ '' ] ifFalse: [ self selectedVariableValue printString ]) ! updateVariablesList variablesList contents: [ :html | self variables do: [ :each || li | li := html li. li with: each key; onClick: [ self selectVariable: each key ]. self selectedVariable = each key ifTrue: [ li class: 'selected' ]] ] ! ! !IDEInspector class methodsFor: 'instance creation'! inspect: anObject ^ self new inspect: anObject; open; yourself ! on: anObject ^ self new inspect: anObject; yourself ! ! TabWidget subclass: #IDETranscript slots: {#textarea} package: 'IDE'! !IDETranscript methodsFor: 'accessing'! label ^ 'Transcript' ! ! !IDETranscript methodsFor: 'actions'! clear textarea asJQuery val: '' ! cr textarea asJQuery val: textarea asJQuery val, String cr. ! open TabManager current open; selectTab: self ! show: anObject textarea ifNil: [ self open ]. textarea asJQuery val: textarea asJQuery val, anObject asString. ! ! !IDETranscript methodsFor: 'rendering'! renderBoxOn: html textarea := html textarea. textarea class: 'amber_transcript'; at: 'spellcheck' put: 'false' ! renderButtonsOn: html html button with: 'Clear transcript'; onClick: [ self clear ] ! ! IDETranscript class slots: {#current}! !IDETranscript class methodsFor: 'initialization'! initialize Transcript register: self current ! ! !IDETranscript class methodsFor: 'instance creation'! current ^ current ifNil: [ current := super new ] ! new self shouldNotImplement ! open TabManager current open; selectTab: self current ! ! TabWidget subclass: #ReferencesBrowser slots: {#implementors. #senders. #implementorsList. #input. #timer. #selector. #sendersList. #referencedClasses. #referencedClassesList. #matches. #matchesList} package: 'IDE'! !ReferencesBrowser methodsFor: 'accessing'! classesAndMetaclasses ^ Smalltalk classes, (Smalltalk classes collect: [ :each | each theMetaClass ]) copyWithout: nil ! implementors ^ implementors ifNil: [ implementors := Array new ] ! label ^ '[ References ]' ! matches ^ matches ifNil: [ matches := Array new ] ! referencedClasses ^ referencedClasses ifNil: [ referencedClasses := Array new ] ! selector ^ selector ! senders ^ senders ifNil: [ senders := Array new ] ! ! !ReferencesBrowser methodsFor: 'actions'! openBrowserOn: aMethod | browser | browser := Browser openOn: (aMethod methodClass isMetaclass ifTrue: [ aMethod methodClass instanceClass ] ifFalse: [ aMethod methodClass ]). aMethod methodClass isMetaclass ifTrue: [ browser selectTab: #class ]. browser selectProtocol: aMethod category; selectMethod: aMethod ! search: aString self searchReferencesFor: aString; updateImplementorsList; updateSendersList; updateReferencedClassesList; updateMatchesList ! searchMethodSource | regex | regex := selector allButFirst. self classesAndMetaclasses do: [ :each | each methodDictionary valuesDo: [ :value | (value source match: regex) ifTrue: [ self matches add: value ]] ] ! searchReferencedClasses self classesAndMetaclasses do: [ :each | each methodDictionary valuesDo: [ :value | (value referencedClasses includes: selector) ifTrue: [ self referencedClasses add: value ]] ] ! searchReferencesFor: aString selector := aString. implementors := Array new. senders := Array new. referencedClasses := Array new. matches := Array new. self searchMethodSource. (selector match: '^[A-Z]') ifFalse: [ self searchSelectorReferences ] ifTrue: [ self searchReferencedClasses ] ! searchSelectorReferences self classesAndMetaclasses do: [ :each | each methodDictionary keysAndValuesDo: [ :key :value | key = selector ifTrue: [ self implementors add: value ]. (value messageSends includes: selector) ifTrue: [ self senders add: value ]] ] ! ! !ReferencesBrowser methodsFor: 'initialization'! initialize super initialize. selector := '' ! ! !ReferencesBrowser methodsFor: 'private'! setInputEvents input onKeyUp: [ timer := [ self search: input asJQuery val ] valueWithTimeout: 100 ]; onKeyDown: [ timer ifNotNil: [ timer clearTimeout ]] ! ! !ReferencesBrowser methodsFor: 'rendering'! renderBoxOn: html self renderInputOn: html; renderImplementorsOn: html; renderSendersOn: html; renderReferencedClassesOn: html; renderMatchesOn: html ! renderImplementorsOn: html implementorsList := html ul class: 'amber_column implementors'. self updateImplementorsList ! renderInputOn: html input := html input class: 'implementors'; yourself. input asJQuery val: selector. self setInputEvents ! renderMatchesOn: html matchesList := html ul class: 'amber_column matches'. self updateMatchesList ! renderReferencedClassesOn: html referencedClassesList := html ul class: 'amber_column referenced_classes'. self updateReferencedClassesList ! renderSendersOn: html sendersList := html ul class: 'amber_column senders'. self updateSendersList ! ! !ReferencesBrowser methodsFor: 'testing'! canBeClosed ^ true ! ! !ReferencesBrowser methodsFor: 'updating'! updateImplementorsList implementorsList contents: [ :html | html li class: 'column_label'; with: 'Implementors (', self implementors size asString, ')'; style: 'font-weight: bold'. self implementors do: [ :each || li | li := html li. li with: each asString; onClick: [ self openBrowserOn: each ]] ] ! updateMatchesList matchesList contents: [ :html | html li class: 'column_label'; with: 'Regex matches (', self matches size asString, ')'; style: 'font-weight: bold'. self matches do: [ :each || li | li := html li. li with: each asString; onClick: [ self openBrowserOn: each ]] ] ! updateReferencedClassesList referencedClassesList contents: [ :html | html li class: 'column_label'; with: 'Class references (', self referencedClasses size asString, ')'; style: 'font-weight: bold'. self referencedClasses do: [ :each | html li with: each asString; onClick: [ self openBrowserOn: each ]] ] ! updateSendersList sendersList contents: [ :html | html li class: 'column_label'; with: 'Senders (', self senders size asString, ')'; style: 'font-weight: bold'. self senders do: [ :each | html li with: each asString; onClick: [ self openBrowserOn: each ]] ] ! ! !ReferencesBrowser class methodsFor: 'instance creation'! search: aString ^ self new searchReferencesFor: aString; open ! ! TabWidget subclass: #TestRunner slots: {#selectedCategories. #packagesList. #selectedClasses. #classesList. #selectedMethods. #progressBar. #methodsList. #result. #statusDiv} package: 'IDE'! !TestRunner methodsFor: 'accessing'! allClasses ^ TestCase allSubclasses select: [ :each | each isAbstract not ] ! classes ^ (self allClasses select: [ :each | self selectedCategories includes: each category ]) sort: [ :a :b | a name > b name ] ! label ^ 'SUnit' ! packages | packages | packages := Array new. self allClasses do: [ :each | (packages includes: each category) ifFalse: [ packages add: each category ]]. ^ packages sort ! progressBar ^ progressBar ifNil: [ progressBar := ProgressBar new ] ! result ^ result ! selectedCategories ^ selectedCategories ifNil: [ selectedCategories := Array new ] ! selectedClasses ^ selectedClasses ifNil: [ selectedClasses := Array new ] ! statusInfo ^ self printTotal, self printPasses, self printErrors, self printFailures ! testCases | testCases | testCases := #(). (self selectedClasses select: [ :each | self selectedCategories includes: each category ]) do: [ :each | testCases addAll: each buildSuite ]. ^ testCases ! ! !TestRunner methodsFor: 'actions'! performFailure: aTestCase aTestCase runCase ! run: aCollection | worker | worker := TestSuiteRunner on: aCollection. result := worker result. worker announcer on: ResultAnnouncement do: [ :ann | ann result == result ifTrue: [ self progressBar updatePercent: result runs / result total * 100. self updateStatusDiv. self updateMethodsList ] ]. worker run ! selectAllCategories self packages do: [ :each | (selectedCategories includes: each) ifFalse: [ self selectedCategories add: each ]]. self updateCategoriesList; updateClassesList ! selectAllClasses self classes do: [ :each | (selectedClasses includes: each) ifFalse: [ self selectedClasses add: each ]]. self updateCategoriesList; updateClassesList ! toggleCategory: aCategory (self isSelectedCategory: aCategory) ifFalse: [ selectedCategories add: aCategory ] ifTrue: [ selectedCategories remove: aCategory ]. self updateCategoriesList; updateClassesList ! toggleClass: aClass (self isSelectedClass: aClass) ifFalse: [ selectedClasses add: aClass ] ifTrue: [ selectedClasses remove: aClass ]. self updateClassesList ! ! !TestRunner methodsFor: 'initialization'! initialize super initialize. result := TestResult new ! ! !TestRunner methodsFor: 'printing'! printErrors ^ self result errors size asString , ' errors, ' ! printFailures ^ self result failures size asString, ' failures' ! printPasses ^ (self result runs - self result errors size - self result failures size) asString , ' passes, ' ! printTotal ^ self result total asString, ' runs, ' ! ! !TestRunner methodsFor: 'rendering'! renderBoxOn: html self renderCategoriesOn: html; renderClassesOn: html; renderResultsOn: html ! renderButtonsOn: html html button with: 'Run selected'; onClick: [ self run: self testCases ] ! renderCategoriesOn: html packagesList := html ul class: 'amber_column sunit packages'. self updateCategoriesList ! renderClassesOn: html classesList := html ul class: 'amber_column sunit classes'. self updateClassesList ! renderErrorsOn: html self result errors do: [ :each | html li class: 'errors'; with: each class name, ' >> ', each selector; onClick: [ self performFailure: each ]] ! renderFailuresOn: html self result failures do: [ :each | html li class: 'failures'; with: each class name, ' >> ', each selector; onClick: [ self performFailure: each ]] ! renderResultsOn: html statusDiv := html div. html with: self progressBar. methodsList := html ul class: 'amber_column sunit results'. self updateMethodsList. self updateStatusDiv ! ! !TestRunner methodsFor: 'testing'! isSelectedCategory: aCategory ^ (self selectedCategories includes: aCategory) ! isSelectedClass: aClass ^ (self selectedClasses includes: aClass) ! ! !TestRunner methodsFor: 'updating'! updateCategoriesList packagesList contents: [ :html | html li class: 'all'; with: 'All'; onClick: [ self selectAllCategories ]. self packages do: [ :each || li | li := html li. (self selectedCategories includes: each) ifTrue: [ li class: 'selected' ]. li with: each; onClick: [ self toggleCategory: each ]] ] ! updateClassesList classesList contents: [ :html | self selectedCategories ifNotEmpty: [ html li class: 'all'; with: 'All'; onClick: [ self selectAllClasses ]]. self classes do: [ :each || li | li := html li. (self selectedClasses includes: each) ifTrue: [ li class: 'selected' ]. li with: each name; onClick: [ self toggleClass: each ]] ] ! updateMethodsList methodsList contents: [ :html | self renderErrorsOn: html. self renderFailuresOn: html ] ! updateStatusDiv statusDiv class: 'sunit status ', result status. statusDiv contents: [ :html | html span with: self statusInfo ] ! ! TabWidget subclass: #Workspace slots: {#sourceArea} package: 'IDE'! !Workspace methodsFor: 'accessing'! label ^ 'Workspace' ! ! !Workspace methodsFor: 'actions'! clearWorkspace sourceArea clear ! doIt sourceArea doIt ! fileIn sourceArea fileIn ! inspectIt sourceArea inspectIt ! printIt sourceArea printIt ! show super show. sourceArea focus. ! ! !Workspace methodsFor: 'rendering'! renderBoxOn: html sourceArea := SourceArea new. sourceArea renderOn: html ! renderButtonsOn: html html button with: 'DoIt'; title: 'ctrl+d'; onClick: [ self doIt ]. html button with: 'PrintIt'; title: 'ctrl+p'; onClick: [ self printIt ]. html button with: 'InspectIt'; title: 'ctrl+i'; onClick: [ self inspectIt ]. html button with: 'FileIn'; title: 'ctrl+f'; onClick: [ self fileIn ]. html button with: 'Clear workspace'; onClick: [ self clearWorkspace ] ! !