From VisualWorks® NonCommercial, 7.7.1 of 2010年7月26日 on 2011年2月2日 at 20:56:09
SSK package
SSK package
comment 'Smalltalk Studies in Kyoto'
OldFashionedBrowser
Smalltalk
UI.ApplicationModel
false
none
classTable classList methodList isMeta codeText
SSK
OldFashionedBrowser
Smalltalk Studies in Kyoto
OldFashionedBrowser class interface specs
windowSpec
"Tools.UIPainter new openOnClass: self andSelector: #windowSpec"
<resource: #canvas>
^#(#{UI.FullSpec}
#window:
#(#{UI.WindowSpec}
#label: 'Old Fashioned Browser'
#min: #(#{Core.Point} 400 300 )
#max: #(#{Core.Point} 0 0 )
#bounds: #(#{Graphics.Rectangle} 480 313 1280 763 ) )
#component:
#(#{UI.SpecCollection}
#collection: #(
#(#{UI.SequenceViewSpec}
#layout: #(#{Graphics.LayoutFrame} 8 0 8 0 -4 0.5 -4 0.5 )
#name: #classList
#model: #classList
#menu: #classListMenu
#useModifierKeys: true
#selectionType: #highlight )
#(#{UI.SequenceViewSpec}
#layout: #(#{Graphics.LayoutFrame} 4 0.5 8 0 -8 1 -40 0.5 )
#name: #methodList
#model: #methodList
#menu: #methodListMenu
#useModifierKeys: true
#selectionType: #highlight )
#(#{UI.RadioButtonSpec}
#layout: #(#{Graphics.LayoutOrigin} 15 0.5 -30 0.5 )
#name: #instanceButton
#model: #isMeta
#label: 'instance'
#select: false )
#(#{UI.RadioButtonSpec}
#layout: #(#{Graphics.LayoutOrigin} 15 0.75 -30 0.5 )
#name: #classButton
#model: #isMeta
#label: 'class'
#select: true )
#(#{UI.TextEditorSpec}
#layout: #(#{Graphics.LayoutFrame} 8 0 4 0.5 -8 1 -8 1 )
#name: #codeText
#model: #codeText
#menu: #codeTextMenu
#tabRequiresControl: true )
#(#{UI.ResizingSplitterSpec}
#layout: #(#{Graphics.LayoutFrame} 8 0 -2 0.5 -8 1 2 0.5 )
#name: #horizontalResizer
#horizontal: true
#minAboveSize: 100
#minBelowSize: 100
#aboveWidgets: 'classList methodList instanceButton classButton verticalResizer'
#belowWidgets: 'codeText' )
#(#{UI.ResizingSplitterSpec}
#layout: #(#{Graphics.LayoutFrame} -2 0.5 8 0 2 0.5 -4 0.5 )
#name: #verticalResizer
#horizontal: false
#minAboveSize: 100
#minBelowSize: 100
#aboveWidgets: 'classList '
#belowWidgets: 'methodList instanceButton classButton' ) ) ) )
OldFashionedBrowser class examples
example
"OldFashionedBrowser example."
^(OldFashionedBrowser new)
open;
yourself
OldFashionedBrowser class resources
methodListMenu
"Tools.MenuEditor new openOnClass: self andSelector: #methodListMenu"
<resource: #menu>
^#(#{UI.Menu} #(
#(#{UI.MenuItem}
#rawLabel: 'Find Method...'
#value: #findMethod ) ) #(1 ) nil ) decodeAsLiteralArray
classListMenu
"Tools.MenuEditor new openOnClass: self andSelector: #classListMenu"
<resource: #menu>
^#(#{UI.Menu} #(
#(#{UI.MenuItem}
#rawLabel: 'Find Class...'
#value: #findClass ) ) #(1 ) nil ) decodeAsLiteralArray
codeTextMenu
"Tools.MenuEditor new openOnClass: self andSelector: #codeTextMenu"
<resource: #menu>
^#(#{UI.Menu} #(
#(#{UI.MenuItem}
#rawLabel: 'Accept'
#value:
#acceptCodeText:from: )
#(#{UI.MenuItem}
#rawLabel: 'Format'
#value:
#formatCodeText:from: ) ) #(2 ) nil ) decodeAsLiteralArray
OldFashionedBrowser accessing
selectedMethod
^self selectedClass
ifNil: [nil yourself]
ifNotNil:
[:aClass |
self methodList selection ifNil: [nil yourself] ifNotNil: [:aSelector | aClass compiledMethodAt: aSelector]]
selectedClass
^self classList selection
ifNil: [nil yourself]
ifNotNil:
[:aKey |
[:aClass | self isMeta value ifTrue: [aClass class] ifFalse: [aClass yourself]]
value: (classTable at: aKey)]
OldFashionedBrowser private
methodListBlock
^
[| aSelector |
aSelector := self methodList selection.
self methodList list: (self selectedClass
ifNil: [SortedCollection new]
ifNotNil: [:aClass | aClass selectors asSortedCollection]).
(aSelector notNil and: [self methodList list includes: aSelector])
ifTrue: [self methodList selection: aSelector]]
menuAt: aSelector ifAbsent: aBlock
^self builder
ifNil: [self class perform: aSelector]
ifNotNil: [:aBuilder | (aBuilder menuAt: aSelector) ifNil: [aBlock value]]
incrementalSearch: aSelectionInList windowLabel: windowLabelString firstLabel: firstLabelString secondLabel: secondLabelString
((IncrementalSearchDialog forSelectionWithSearch:
[:aPattern |
(aPattern isEmpty
ifTrue: [aSelectionInList list copy]
ifFalse: [aSelectionInList list select: [:each | aPattern , '*' match: each]]) asSortedCollection])
windowLabel: windowLabelString;
firstLabel: firstLabelString;
secondLabel: secondLabelString;
select) ifNotNil: [:anElement | aSelectionInList selection: anElement]
codeTextBlock
^
[self codeText value: (self selectedClass
ifNil: [Text new]
ifNotNil:
[:aClass |
self selectedMethod
ifNil: [aClass definition asText]
ifNotNil: [:aMethod | (aClass sourceMethodAt: aMethod selector) asText]])]
OldFashionedBrowser menu messages
findMethod
self methodList list isEmpty ifTrue: [^nil].
self
incrementalSearch: self methodList
windowLabel: 'Find Method'
firstLabel: 'Filter:'
secondLabel: 'Methods:'
formatCodeText: aText from: aController
Transcript
cr;
show: thisContext printString
acceptCodeText: aText from: aController
Transcript
cr;
show: thisContext printString
findClass
self classList list isEmpty ifTrue: [^nil].
self
incrementalSearch: self classList
windowLabel: 'Find Class'
firstLabel: 'Filter:'
secondLabel: 'Classes:'
OldFashionedBrowser interface opening
postOpenWith: aBuilder
super postOpenWith: aBuilder.
Transcript
cr;
show: thisContext printString
postBuildWith: aBuilder
| aMenu anItem |
super postBuildWith: aBuilder.
aMenu := self menuAt: #codeTextMenu ifAbsent: [^nil].
anItem := aMenu menuItemWithValue: #acceptCodeText:from:.
anItem disable.
(aBuilder componentAt: #codeText)
ifNotNil:
[:specWrapper |
specWrapper widget controller keyboardHook:
[:aKeyboardEvent :aController |
anItem enable.
aKeyboardEvent yourself]]
OldFashionedBrowser initialize-release
initialize
super initialize.
classTable := Dictionary new: 1000.
SystemUtils allClassesDo: [:aClass | classTable at: aClass toolListDisplayString put: aClass].
classList := nil.
methodList := nil.
isMeta := nil.
codeText := nil.
^self yourself
OldFashionedBrowser aspects
codeText
codeText ifNil: [codeText := ValueHolder with: Text new].
^codeText
methodList
methodList
ifNil:
[methodList := SelectionInList new.
BlockValue block: self codeTextBlock arguments: (Array with: methodList)].
^methodList
classList
classList
ifNil:
[classList := SelectionInList new.
classList list: classTable keys asSortedCollection.
BlockValue block: self methodListBlock arguments: (Array with: classList)].
^classList
isMeta
isMeta
ifNil:
[isMeta := ValueHolder with: false.
BlockValue block: self methodListBlock arguments: (Array with: isMeta)].
^isMeta