|
@@ -0,0 +1,2397 @@
|
|
|
+Smalltalk createPackage: 'IDE'!
|
|
|
+Widget subclass: #ClassesList
|
|
|
+ instanceVariableNames: 'browser ul nodes'
|
|
|
+ package: 'IDE'!
|
|
|
+
|
|
|
+!ClassesList methodsFor: 'accessing'!
|
|
|
+
|
|
|
+browser
|
|
|
+ ^ browser
|
|
|
+!
|
|
|
+
|
|
|
+browser: aBrowser
|
|
|
+ browser := aBrowser
|
|
|
+!
|
|
|
+
|
|
|
+category
|
|
|
+ ^ self browser selectedPackage
|
|
|
+!
|
|
|
+
|
|
|
+getNodes
|
|
|
+ | classes children others |
|
|
|
+ classes := self browser classes.
|
|
|
+ children := #().
|
|
|
+ others := #().
|
|
|
+ classes do: [ :each |
|
|
|
+ (classes includes: each superclass)
|
|
|
+ ifFalse: [ children add: each ]
|
|
|
+ ifTrue: [ others add: each ]].
|
|
|
+ ^ children collect: [ :each |
|
|
|
+ ClassesListNode on: each browser: self browser classes: others level: 0 ]
|
|
|
+!
|
|
|
+
|
|
|
+nodes
|
|
|
+ nodes ifNil: [ nodes := self getNodes ].
|
|
|
+ ^ nodes
|
|
|
+!
|
|
|
+
|
|
|
+resetNodes
|
|
|
+ nodes := nil
|
|
|
+! !
|
|
|
+
|
|
|
+!ClassesList methodsFor: 'rendering'!
|
|
|
+
|
|
|
+renderOn: html
|
|
|
+ ul := html ul
|
|
|
+ class: 'amber_column browser classes';
|
|
|
+ yourself.
|
|
|
+ self updateNodes
|
|
|
+!
|
|
|
+
|
|
|
+updateNodes
|
|
|
+ ul contents: [ :html |
|
|
|
+ self nodes do: [ :each |
|
|
|
+ each renderOn: html ]]
|
|
|
+! !
|
|
|
+
|
|
|
+!ClassesList class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+on: aBrowser
|
|
|
+ ^ self new
|
|
|
+ browser: aBrowser;
|
|
|
+ yourself
|
|
|
+! !
|
|
|
+
|
|
|
+Widget subclass: #ClassesListNode
|
|
|
+ instanceVariableNames: 'browser theClass level nodes'
|
|
|
+ package: 'IDE'!
|
|
|
+
|
|
|
+!ClassesListNode methodsFor: 'accessing'!
|
|
|
+
|
|
|
+browser
|
|
|
+ ^ browser
|
|
|
+!
|
|
|
+
|
|
|
+browser: aBrowser
|
|
|
+ browser := aBrowser
|
|
|
+!
|
|
|
+
|
|
|
+getNodesFrom: aCollection
|
|
|
+ | children others |
|
|
|
+ children := #().
|
|
|
+ others := #().
|
|
|
+ aCollection do: [ :each |
|
|
|
+ (each superclass = self theClass)
|
|
|
+ ifTrue: [ children add: each ]
|
|
|
+ ifFalse: [ others add: each ]].
|
|
|
+ nodes:= children collect: [ :each |
|
|
|
+ ClassesListNode on: each browser: self browser classes: others level: self level + 1 ]
|
|
|
+!
|
|
|
+
|
|
|
+label
|
|
|
+ | str |
|
|
|
+ str := String new writeStream.
|
|
|
+ self level timesRepeat: [
|
|
|
+ str nextPutAll: ' ' ].
|
|
|
+ str nextPutAll: self theClass name.
|
|
|
+ ^ str contents
|
|
|
+!
|
|
|
+
|
|
|
+level
|
|
|
+ ^ level
|
|
|
+!
|
|
|
+
|
|
|
+level: anInteger
|
|
|
+ level := anInteger
|
|
|
+!
|
|
|
+
|
|
|
+nodes
|
|
|
+ ^ nodes
|
|
|
+!
|
|
|
+
|
|
|
+theClass
|
|
|
+ ^ theClass
|
|
|
+!
|
|
|
+
|
|
|
+theClass: aClass
|
|
|
+ theClass := aClass
|
|
|
+! !
|
|
|
+
|
|
|
+!ClassesListNode methodsFor: 'rendering'!
|
|
|
+
|
|
|
+renderOn: html
|
|
|
+ | li cssClass |
|
|
|
+ cssClass := ''.
|
|
|
+ li := html li
|
|
|
+ onClick: [ self browser selectClass: self theClass ].
|
|
|
+ li asJQuery html: self label.
|
|
|
+
|
|
|
+ self browser selectedClass = self theClass ifTrue: [
|
|
|
+ cssClass := cssClass, ' selected' ].
|
|
|
+
|
|
|
+ self theClass comment isEmpty ifFalse: [
|
|
|
+ cssClass := cssClass, ' commented' ].
|
|
|
+
|
|
|
+ li class: cssClass.
|
|
|
+
|
|
|
+ self nodes do: [ :each |
|
|
|
+ each renderOn: html ]
|
|
|
+! !
|
|
|
+
|
|
|
+!ClassesListNode class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+on: aClass browser: aBrowser classes: aCollection level: anInteger
|
|
|
+ ^ self new
|
|
|
+ theClass: aClass;
|
|
|
+ browser: aBrowser;
|
|
|
+ level: anInteger;
|
|
|
+ getNodesFrom: aCollection;
|
|
|
+ yourself
|
|
|
+! !
|
|
|
+
|
|
|
+Object subclass: #DebugErrorHandler
|
|
|
+ instanceVariableNames: ''
|
|
|
+ package: 'IDE'!
|
|
|
+
|
|
|
+!DebugErrorHandler methodsFor: 'error handling'!
|
|
|
+
|
|
|
+handleError: anError
|
|
|
+ [ Debugger new
|
|
|
+ error: anError;
|
|
|
+ open ] on: Error do: [ :error |
|
|
|
+ ConsoleErrorHandler new handleError: error ]
|
|
|
+! !
|
|
|
+
|
|
|
+!DebugErrorHandler class methodsFor: 'initialization'!
|
|
|
+
|
|
|
+initialize
|
|
|
+ ErrorHandler register: self new
|
|
|
+! !
|
|
|
+
|
|
|
+Widget subclass: #SourceArea
|
|
|
+ instanceVariableNames: '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
|
|
|
+ <self['@editor'] = self._class()._codeMirror().fromTextArea(aTextarea, {
|
|
|
+ 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 |
|
|
|
+ ^ self alert: ex messageText ].
|
|
|
+ ^ compiler evaluateExpression: aString on: self receiver
|
|
|
+!
|
|
|
+
|
|
|
+fileIn
|
|
|
+ Importer new import: self currentLineOrSelection readStream
|
|
|
+!
|
|
|
+
|
|
|
+focus
|
|
|
+ self editor focus.
|
|
|
+!
|
|
|
+
|
|
|
+handleKeyDown: anEvent
|
|
|
+ <if(anEvent.ctrlKey) {
|
|
|
+ if(anEvent.keyCode === 80) { //ctrl+p
|
|
|
+ self._printIt();
|
|
|
+ anEvent.preventDefault();
|
|
|
+ return false;
|
|
|
+ }
|
|
|
+ if(anEvent.keyCode === 68) { //ctrl+d
|
|
|
+ self._doIt();
|
|
|
+ anEvent.preventDefault();
|
|
|
+ return false;
|
|
|
+ }
|
|
|
+ if(anEvent.keyCode === 73) { //ctrl+i
|
|
|
+ self._inspectIt();
|
|
|
+ anEvent.preventDefault();
|
|
|
+ return false;
|
|
|
+ }
|
|
|
+ }>
|
|
|
+!
|
|
|
+
|
|
|
+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 element.
|
|
|
+ div onKeyDown: [ :e | self handleKeyDown: e ]
|
|
|
+! !
|
|
|
+
|
|
|
+!SourceArea class methodsFor: 'accessing'!
|
|
|
+
|
|
|
+codeMirror
|
|
|
+ ^ require value: 'codemirror/lib/codemirror'
|
|
|
+! !
|
|
|
+
|
|
|
+!SourceArea class methodsFor: 'initialization'!
|
|
|
+
|
|
|
+initialize
|
|
|
+ super initialize.
|
|
|
+ self setupCodeMirror
|
|
|
+!
|
|
|
+
|
|
|
+setupCodeMirror
|
|
|
+ < self._codeMirror().keyMap["default"].fallthrough = ["basic"] >
|
|
|
+! !
|
|
|
+
|
|
|
+Widget subclass: #TabManager
|
|
|
+ instanceVariableNames: '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 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 instanceVariableNames: '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
|
|
|
+ instanceVariableNames: '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
|
|
|
+ instanceVariableNames: 'selectedPackage selectedClass selectedProtocol selectedMethod packagesList classesList protocolsList methodsList sourceArea tabsList selectedTab saveButton classButtons methodButtons unsavedChanges'
|
|
|
+ package: 'IDE'!
|
|
|
+
|
|
|
+!Browser methodsFor: 'accessing'!
|
|
|
+
|
|
|
+classCommentSource
|
|
|
+ ^ selectedClass comment
|
|
|
+!
|
|
|
+
|
|
|
+classDeclarationSource
|
|
|
+ | stream |
|
|
|
+ stream := '' writeStream.
|
|
|
+ selectedClass ifNil: [ ^ self classDeclarationTemplate ].
|
|
|
+ stream
|
|
|
+ nextPutAll: selectedClass superclass asString;
|
|
|
+ nextPutAll: ' subclass: #';
|
|
|
+ nextPutAll: selectedClass name;
|
|
|
+ nextPutAll: String lf, String tab;
|
|
|
+ nextPutAll: 'instanceVariableNames: '''.
|
|
|
+ selectedClass instanceVariableNames
|
|
|
+ do: [ :each | stream nextPutAll: each ]
|
|
|
+ separatedBy: [ stream nextPutAll: ' ' ].
|
|
|
+ stream
|
|
|
+ nextPutAll: '''', String lf, String tab;
|
|
|
+ nextPutAll: 'package: ''';
|
|
|
+ nextPutAll: selectedClass category;
|
|
|
+ nextPutAll: ''''.
|
|
|
+ ^ stream contents
|
|
|
+!
|
|
|
+
|
|
|
+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
|
|
|
+ ^ selectedTab = #instance
|
|
|
+ ifTrue: [ self classDeclarationSource ]
|
|
|
+ ifFalse: [ self metaclassDeclarationSource ]
|
|
|
+!
|
|
|
+
|
|
|
+dummyMethodSource
|
|
|
+ ^ 'messageSelectorAndArgumentNames
|
|
|
+ "comment stating purpose of message"
|
|
|
+
|
|
|
+ | temporary variable names |
|
|
|
+ statements'
|
|
|
+!
|
|
|
+
|
|
|
+label
|
|
|
+ ^ selectedClass
|
|
|
+ ifNil: [ 'Browser (nil)' ]
|
|
|
+ ifNotNil: [ 'Browser: ', selectedClass name ]
|
|
|
+!
|
|
|
+
|
|
|
+metaclassDeclarationSource
|
|
|
+ | stream |
|
|
|
+ stream := '' writeStream.
|
|
|
+ selectedClass ifNotNil: [
|
|
|
+ stream
|
|
|
+ nextPutAll: selectedClass asString;
|
|
|
+ nextPutAll: ' class ';
|
|
|
+ nextPutAll: 'instanceVariableNames: '''.
|
|
|
+ selectedClass class instanceVariableNames
|
|
|
+ do: [ :each | stream nextPutAll: each ]
|
|
|
+ separatedBy: [ stream nextPutAll: ' ' ].
|
|
|
+ stream nextPutAll: '''' ].
|
|
|
+ ^ stream contents
|
|
|
+!
|
|
|
+
|
|
|
+methodSource
|
|
|
+ ^ selectedMethod
|
|
|
+ ifNil: [ self dummyMethodSource ]
|
|
|
+ ifNotNil: [ selectedMethod source ]
|
|
|
+!
|
|
|
+
|
|
|
+methods
|
|
|
+ | klass |
|
|
|
+ selectedTab = #comment ifTrue: [ ^ #() ].
|
|
|
+ selectedClass ifNotNil: [
|
|
|
+ klass := selectedTab = #instance
|
|
|
+ ifTrue: [ selectedClass ]
|
|
|
+ ifFalse: [ selectedClass class ]].
|
|
|
+ ^ (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 ifNotNil: [
|
|
|
+ selectedTab = #comment ifTrue: [ ^ #() ].
|
|
|
+ klass := selectedTab = #instance
|
|
|
+ ifTrue: [ selectedClass ]
|
|
|
+ ifFalse: [ selectedClass class ].
|
|
|
+ klass methodDictionary isEmpty ifTrue: [
|
|
|
+ ^ Array with: 'not yet classified' ].
|
|
|
+ ^ klass protocols ].
|
|
|
+ ^ Array new
|
|
|
+!
|
|
|
+
|
|
|
+selectedClass
|
|
|
+ ^ selectedClass
|
|
|
+!
|
|
|
+
|
|
|
+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'!
|
|
|
+
|
|
|
+addInstanceVariableNamed: aString toClass: aClass
|
|
|
+ ClassBuilder new
|
|
|
+ addSubclassOf: aClass superclass
|
|
|
+ named: aClass name
|
|
|
+ instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
|
|
|
+ package: aClass package name
|
|
|
+!
|
|
|
+
|
|
|
+addNewClass
|
|
|
+ | className |
|
|
|
+ className := self 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 := self prompt: 'New method protocol'.
|
|
|
+
|
|
|
+ (newProtocol notNil and: [ newProtocol notEmpty ]) ifTrue: [
|
|
|
+ selectedMethod protocol: newProtocol.
|
|
|
+ self setMethodProtocol: newProtocol ]
|
|
|
+!
|
|
|
+
|
|
|
+cancelChanges
|
|
|
+ ^ unsavedChanges
|
|
|
+ ifTrue: [ self 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
|
|
|
+ selectedTab = #instance
|
|
|
+ ifTrue: [ self compileMethodDefinitionFor: selectedClass ]
|
|
|
+ ifFalse: [ self compileMethodDefinitionFor: selectedClass class ]
|
|
|
+!
|
|
|
+
|
|
|
+compileMethodDefinitionFor: aClass
|
|
|
+ | compiler method source node |
|
|
|
+ source := sourceArea val.
|
|
|
+ selectedProtocol ifNil: [ selectedProtocol := selectedMethod protocol ].
|
|
|
+ compiler := Compiler new.
|
|
|
+ compiler source: source.
|
|
|
+ node := compiler parse: source.
|
|
|
+ node isParseFailure ifTrue: [
|
|
|
+ ^ self alert: 'PARSE ERROR: ', node reason, ', position: ', node position asString ].
|
|
|
+ compiler currentClass: aClass.
|
|
|
+ method := compiler eval: (compiler compileNode: node).
|
|
|
+ compiler unknownVariables do: [ :each |
|
|
|
+ "Do not try to redeclare javascript's objects"
|
|
|
+ (PlatformInterface existsGlobal: each) ifFalse: [
|
|
|
+ (self confirm: 'Declare ''', each, ''' as instance variable?') ifTrue: [
|
|
|
+ self addInstanceVariableNamed: each toClass: aClass.
|
|
|
+ ^ self compileMethodDefinitionFor: aClass ]] ].
|
|
|
+ ClassBuilder new installMethod: method forClass: aClass protocol: selectedProtocol.
|
|
|
+ self updateMethodsList.
|
|
|
+ self selectMethod: method
|
|
|
+!
|
|
|
+
|
|
|
+copyClass
|
|
|
+ | className |
|
|
|
+ className := self 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
|
|
|
+ <if(anEvent.ctrlKey) {
|
|
|
+ if(anEvent.keyCode === 83) { //ctrl+s
|
|
|
+ self._compile();
|
|
|
+ anEvent.preventDefault();
|
|
|
+ return false;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ >
|
|
|
+!
|
|
|
+
|
|
|
+hideClassButtons
|
|
|
+ classButtons asJQuery hide
|
|
|
+!
|
|
|
+
|
|
|
+hideMethodButtons
|
|
|
+ methodButtons asJQuery hide
|
|
|
+!
|
|
|
+
|
|
|
+removeClass
|
|
|
+ (self confirm: 'Do you really want to remove ', selectedClass name, '?')
|
|
|
+ ifTrue: [
|
|
|
+ Smalltalk removeClass: selectedClass.
|
|
|
+ self resetClassesList.
|
|
|
+ self selectClass: nil ]
|
|
|
+!
|
|
|
+
|
|
|
+removeMethod
|
|
|
+ self cancelChanges ifTrue: [
|
|
|
+ (self confirm: 'Do you really want to remove #', selectedMethod selector, '?')
|
|
|
+ ifTrue: [
|
|
|
+ selectedTab = #instance
|
|
|
+ ifTrue: [ selectedClass removeCompiledMethod: selectedMethod ]
|
|
|
+ ifFalse: [ selectedClass class removeCompiledMethod: selectedMethod ].
|
|
|
+ self selectMethod: nil ]]
|
|
|
+!
|
|
|
+
|
|
|
+removePackage
|
|
|
+
|
|
|
+ (self confirm: 'Do you really want to remove the whole package ', selectedPackage, ' with all its classes?')
|
|
|
+ ifTrue: [
|
|
|
+ Smalltalk removePackage: selectedPackage.
|
|
|
+ self updateCategoriesList ]
|
|
|
+!
|
|
|
+
|
|
|
+renameClass
|
|
|
+ | newName |
|
|
|
+ newName := self prompt: 'Rename class ', selectedClass name.
|
|
|
+ (newName notNil and: [ newName notEmpty ]) ifTrue: [
|
|
|
+ selectedClass rename: newName.
|
|
|
+ self
|
|
|
+ updateClassesList;
|
|
|
+ updateSourceAndButtons ]
|
|
|
+!
|
|
|
+
|
|
|
+renamePackage
|
|
|
+
|
|
|
+ | newName |
|
|
|
+ newName := self prompt: 'Rename package ', selectedPackage.
|
|
|
+ newName ifNotNil: [
|
|
|
+ newName notEmpty ifTrue: [
|
|
|
+ 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
|
|
|
+ self cancelChanges ifTrue: [
|
|
|
+ (self protocols includes: aString)
|
|
|
+ ifFalse: [ self addNewProtocol ]
|
|
|
+ ifTrue: [
|
|
|
+ selectedMethod protocol: aString.
|
|
|
+ selectedProtocol := aString.
|
|
|
+ selectedMethod := selectedMethod.
|
|
|
+ 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 |
|
|
|
+ each isEmpty
|
|
|
+ ifTrue: [ label := 'Unclassified' ]
|
|
|
+ ifFalse: [ label := each ].
|
|
|
+ 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;
|
|
|
+ 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
|
|
|
+ instanceVariableNames: '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 instVarAt: 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 |
|
|
|
+ li := html li.
|
|
|
+ selectedContext = aContext ifTrue: [
|
|
|
+ li class: 'selected' ].
|
|
|
+ li
|
|
|
+ with: aContext asString;
|
|
|
+ onClick: [ self selectContext: aContext ].
|
|
|
+ aContext outerContext ifNotNil: [ self renderContext: aContext outerContext on: html ]
|
|
|
+!
|
|
|
+
|
|
|
+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
|
|
|
+ instanceVariableNames: 'label variables object selectedVariable variablesList valueTextarea diveButton sourceArea'
|
|
|
+ package: 'IDE'!
|
|
|
+
|
|
|
+!IDEInspector methodsFor: 'accessing'!
|
|
|
+
|
|
|
+label
|
|
|
+ ^ label ifNil: [ 'Inspector (nil)' ]
|
|
|
+!
|
|
|
+
|
|
|
+selectedVariable
|
|
|
+ ^ selectedVariable
|
|
|
+!
|
|
|
+
|
|
|
+selectedVariable: aString
|
|
|
+ selectedVariable := aString
|
|
|
+!
|
|
|
+
|
|
|
+setLabel: aString
|
|
|
+ label := aString
|
|
|
+!
|
|
|
+
|
|
|
+setVariables: aCollection
|
|
|
+ variables := aCollection
|
|
|
+!
|
|
|
+
|
|
|
+sourceArea
|
|
|
+ ^ sourceArea
|
|
|
+!
|
|
|
+
|
|
|
+variables
|
|
|
+ ^ variables
|
|
|
+! !
|
|
|
+
|
|
|
+!IDEInspector methodsFor: 'actions'!
|
|
|
+
|
|
|
+dive
|
|
|
+ (self variables at: self selectedVariable) 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 variables at: self selectedVariable) notNil ])
|
|
|
+ ifFalse: [ diveButton at: 'disabled' put: true ]
|
|
|
+ ifTrue: [ diveButton removeAt: 'disabled' ]
|
|
|
+!
|
|
|
+
|
|
|
+updateValueTextarea
|
|
|
+ valueTextarea asJQuery val: (self selectedVariable isNil
|
|
|
+ ifTrue: [ '' ]
|
|
|
+ ifFalse: [ (self variables at: self selectedVariable) printString ])
|
|
|
+!
|
|
|
+
|
|
|
+updateVariablesList
|
|
|
+ variablesList contents: [ :html |
|
|
|
+ self variables keysDo: [ :each || li |
|
|
|
+ li := html li.
|
|
|
+ li
|
|
|
+ with: each;
|
|
|
+ onClick: [ self selectVariable: each ].
|
|
|
+ self selectedVariable = each 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
|
|
|
+ instanceVariableNames: '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 instanceVariableNames: '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: #ProgressBar
|
|
|
+ instanceVariableNames: '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
|
|
|
+! !
|
|
|
+
|
|
|
+TabWidget subclass: #ReferencesBrowser
|
|
|
+ instanceVariableNames: 'implementors senders implementorsList input timer selector sendersList referencedClasses referencedClassesList matches matchesList'
|
|
|
+ package: 'IDE'!
|
|
|
+
|
|
|
+!ReferencesBrowser methodsFor: 'accessing'!
|
|
|
+
|
|
|
+classesAndMetaclasses
|
|
|
+ ^ Smalltalk classes, (Smalltalk classes collect: [ :each | each class ])
|
|
|
+!
|
|
|
+
|
|
|
+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 methodClass asString, ' >> ', self selector);
|
|
|
+ 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 methodClass asString, ' >> ', each selector);
|
|
|
+ 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 methodClass asString, ' >> ', each selector);
|
|
|
+ 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 methodClass asString, ' >> ', each selector);
|
|
|
+ onClick: [ self openBrowserOn: each ]] ]
|
|
|
+! !
|
|
|
+
|
|
|
+!ReferencesBrowser class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+search: aString
|
|
|
+ ^ self new
|
|
|
+ searchReferencesFor: aString;
|
|
|
+ open
|
|
|
+! !
|
|
|
+
|
|
|
+TabWidget subclass: #TestRunner
|
|
|
+ instanceVariableNames: '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 isEmpty) ifFalse: [
|
|
|
+ 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
|
|
|
+ instanceVariableNames: '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 ]
|
|
|
+! !
|
|
|
+
|
|
|
+!AssociativeCollection methodsFor: '*IDE'!
|
|
|
+
|
|
|
+inspectOn: anInspector
|
|
|
+ | variables |
|
|
|
+ variables := Dictionary new.
|
|
|
+ variables at: '#self' put: self.
|
|
|
+ variables at: '#keys' put: self keys.
|
|
|
+ self keysAndValuesDo: [ :key :value |
|
|
|
+ variables at: key put: value ].
|
|
|
+ anInspector
|
|
|
+ setLabel: self printString;
|
|
|
+ setVariables: variables
|
|
|
+! !
|
|
|
+
|
|
|
+!Collection methodsFor: '*IDE'!
|
|
|
+
|
|
|
+inspectOn: anInspector
|
|
|
+ | variables |
|
|
|
+ variables := Dictionary new.
|
|
|
+ variables at: '#self' put: self.
|
|
|
+ self withIndexDo: [ :each :i |
|
|
|
+ variables at: i put: each ].
|
|
|
+ anInspector
|
|
|
+ setLabel: self printString;
|
|
|
+ setVariables: variables
|
|
|
+! !
|
|
|
+
|
|
|
+!Date methodsFor: '*IDE'!
|
|
|
+
|
|
|
+inspectOn: anInspector
|
|
|
+ | variables |
|
|
|
+ variables := Dictionary new.
|
|
|
+ variables at: '#self' put: self.
|
|
|
+ variables at: '#year' put: self year.
|
|
|
+ variables at: '#month' put: self month.
|
|
|
+ variables at: '#day' put: self day.
|
|
|
+ variables at: '#hours' put: self hours.
|
|
|
+ variables at: '#minutes' put: self minutes.
|
|
|
+ variables at: '#seconds' put: self seconds.
|
|
|
+ variables at: '#milliseconds' put: self milliseconds.
|
|
|
+ anInspector
|
|
|
+ setLabel: self printString;
|
|
|
+ setVariables: variables
|
|
|
+! !
|
|
|
+
|
|
|
+!MethodContext methodsFor: '*IDE'!
|
|
|
+
|
|
|
+inspectOn: anInspector
|
|
|
+ | variables |
|
|
|
+ variables := Dictionary new.
|
|
|
+ variables at: '#self' put: self.
|
|
|
+ variables at: '#home' put: self home.
|
|
|
+ variables at: '#receiver' put: self receiver.
|
|
|
+ variables at: '#selector' put: self selector.
|
|
|
+ variables at: '#locals' put: self locals.
|
|
|
+ self class instanceVariableNames do: [ :each |
|
|
|
+ variables at: each put: (self instVarAt: each) ].
|
|
|
+ anInspector
|
|
|
+ setLabel: self printString;
|
|
|
+ setVariables: variables
|
|
|
+! !
|
|
|
+
|
|
|
+!Set methodsFor: '*IDE'!
|
|
|
+
|
|
|
+inspectOn: anInspector
|
|
|
+ | variables i |
|
|
|
+ variables := Dictionary new.
|
|
|
+ variables at: '#self' put: self.
|
|
|
+ i := 1.
|
|
|
+ self do: [ :each |
|
|
|
+ variables at: i put: each.
|
|
|
+ i := i + 1 ].
|
|
|
+ anInspector
|
|
|
+ setLabel: self printString;
|
|
|
+ setVariables: variables
|
|
|
+! !
|
|
|
+
|
|
|
+!String methodsFor: '*IDE'!
|
|
|
+
|
|
|
+inspectOn: anInspector
|
|
|
+ | label |
|
|
|
+ super inspectOn: anInspector.
|
|
|
+ self printString size > 30
|
|
|
+ ifTrue: [ label := (self printString copyFrom: 1 to: 30), '...''' ]
|
|
|
+ ifFalse: [ label := self printString ].
|
|
|
+ anInspector setLabel: label
|
|
|
+! !
|
|
|
+
|