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 |
ErrorHandler 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'] = 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: 'initialization'!
initialize
super initialize.
self setupCodeMirror
!
setupCodeMirror
< 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 temps
!
save
| protocol |
protocol := (selectedContext receiver class methodDictionary at: selectedContext selector) category.
selectedContext receiver class compile: sourceArea val category: 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
! !