"{ NameSpace: NewInspector }"
SimpleView subclass:#InspectorPanelView
instanceVariableNames:'frames labelViews listViews scrollBar maxDepth leftHistory
rightHistory hzpView actionBlock valueChangedAction'
classVariableNames:''
poolDictionaries:''
category:'Inspector'
!
!InspectorPanelView class methodsFor:'documentation'!
examples
"
example 1
=========
[exBegin]
|top slv|
top := StandardSystemView new extent:600@400.
slv := NewInspector::InspectorPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
slv inspect:top.
slv action:[:el|Transcript showCR:el].
top open.
[exEnd]
example 2
=========
[exBegin]
|top slv edt a vvp|
a := Array new:5.
a at:4 put:(Array new:6).
top := StandardSystemView new extent:600@400.
vvp := VariableVerticalPanel origin:0.0@0.0 corner:1.0@1.0 in:top.
slv := NewInspector::InspectorPanelView origin:0.0@0.0 corner:1.0@0.5 in:vvp.
edt := Workspace origin:0.0 @ 0.5 corner:1.0 @ 1.0 in:vvp.
edt acceptAction:[:theText|slv accept:theText notifying:edt].
edt doItAction:[:theCode|slv doIt:theCode notifying:edt].
slv action:[:el| Transcript showCR:(el printString)].
slv inspect:a.
top open.
[exEnd]
"
! !
!InspectorPanelView class methodsFor:'constants'!
minDepth
"returns the minimum of views assigned to a panel
"
^ 4
! !
!InspectorPanelView methodsFor:'accessing'!
depth
"returns number of listViews
"
^ listViews size
!
depth:aDepth
"change the number of existing listViews
"
|sz min|
min := self class minDepth.
aDepth > min ifTrue:[
sz := aDepth min:maxDepth.
sz < listViews size ifTrue:[
sz := listViews size
]
] ifFalse:[
sz := min
].
listViews size == sz ifTrue:[
sz == aDepth ifFalse:[self moveContentsLeft:1].
] ifFalse:[
[self createViewWithoutRedraw. listViews size ~~ sz] whileTrue.
self computeExtentOfFrames.
(self topView shown) ifTrue:[
hzpView sizeChanged:nil.
hzpView realizeAllSubViews.
]
]
!
maxDepth
^ maxDepth
!
maxDepth:aNumber
"change max depth for instance
"
aNumber > listViews size ifTrue:[
aNumber >= (self class minDepth) ifTrue:[
maxDepth := aNumber.
maxDepth < listViews size ifTrue:[
self depth:maxDepth
]
]
]
! !
!InspectorPanelView methodsFor:'accessing actions'!
action:aOneArgBlock
"set the single click action block.
If non-nil, that one is evaluated on single click, passing the
selected instance as argument
"
actionBlock := aOneArgBlock
!
valueChangedAction:aOneArgBlock
"evaluated if an instnace changed its value; passing
the instance as argument
"
valueChangedAction := aOneArgBlock
! !
!InspectorPanelView methodsFor:'accessing selections'!
inspectedObject
"returns the current inspected object
"
^ self findLastValidListWithSelection inspectedObject
!
selectedInstanceVar
"returns the current selected instance var
"
^ self findLastValidListWithSelection selectedInstanceVar
! !
!InspectorPanelView methodsFor:'actions'!
accept:aText notifying:aView
"evaluating aText on the last selected instance var. on success the views
are updated.
"
self doItOrAccept:[:aList|aList accept:aText notifying:aView]
!
doIt:aCode notifying:aView
"evaluating aCode on the selected instance var; on success the views
are updated.
"
^ self doItOrAccept:[:aList|aList doIt:aCode notifying:aView]
!
inspect:anObject
"change the inspected object and all views
"
|view|
view := listViews first.
leftHistory removeAll.
rightHistory removeAll.
view inspect:anObject.
listViews from:2 do:[:v|v inspect:nil].
self update.
! !
!InspectorPanelView methodsFor:'event handling'!
handlesKeyPress:key inView:someView
"all keys are handled by this instance itself
"
^ true
!
keyPress:key x:x y:y view:someView
"handle some special keys
"
key == #CursorLeft ifTrue:[^ self moveContentsRight:1].
key == #CursorRight ifTrue:[^ self moveContentsLeft:1 ].
someView keyPress:key x:x y:y.
!
singleClickAt:anIndex
"the view at an index changed its selection caused by a single click
"
|view start sivar|
rightHistory removeAll.
view := listViews at:anIndex.
start := anIndex + 1.
sivar := view selectedInstanceVar.
start > listViews size ifTrue:[
start >= maxDepth ifTrue:[
self moveContentsLeft:1.
^ actionBlock value:sivar.
].
].
(view selectedInstanceType) == #directory ifTrue:[
(listViews at:start) setSelection:nil.
(listViews at:start) inspect:sivar.
start := start + 1.
].
listViews from:start do:[:v|v inspect:nil].
self update.
actionBlock value:sivar.
! !
!InspectorPanelView methodsFor:'initializing'!
initialize
"initialize instance
"
super initialize.
frames := OrderedCollection new.
listViews := OrderedCollection new.
labelViews := OrderedCollection new.
leftHistory := OrderedCollection new.
rightHistory := OrderedCollection new.
maxDepth := self class minDepth.
actionBlock := [:el| ].
hzpView := VariableHorizontalPanel origin:0.0@0.0 corner:1.0@1.0 in:self.
scrollBar := HorizontalScrollBar origin:0.0@1.0 corner:1.0@1.0 in:self.
scrollBar asynchronousOperation.
hzpView bottomInset:(scrollBar preferredExtent y).
scrollBar topInset:(scrollBar preferredExtent y) negated.
scrollBar thumbHeight:100.
scrollBar scrollAction:[:percent | self scrollTo:percent].
scrollBar scrollRightAction:[self moveContentsLeft:1].
scrollBar scrollLeftAction:[self moveContentsRight:1].
self depth:maxDepth.
! !
!InspectorPanelView methodsFor:'menu - labels & actions'!
browse:anIndex
self classAtLabel:anIndex do:[:cls| cls browserClass openInClass:cls selector:nil ]
!
browseClassHierarchy:anIndex
self classAtLabel:anIndex do:[:cls| cls browserClass browseClassHierarchy:cls ]
!
browseFullClassProtocol:anIndex
self classAtLabel:anIndex do:[:cls| cls browserClass browseFullClassProtocol:cls ]
!
classAtLabel:anIndex do:anAction
"evaluate action on class assigned to label
"
|cls|
anIndex <= labelViews size ifTrue:[
(cls := Smalltalk classNamed:((labelViews at:anIndex) label)) notNil ifTrue:[
anAction value:cls
]
]
!
labelMenu
"popup menu required by any label. Delegate the request to the corresponding label
"
|sqNr view|
view := (WindowGroup lastEventQuerySignal raise) view.
sqNr := labelViews findFirst:[:v| v == view].
sqNr ~~ 0 ifTrue:[
view := labelViews at:sqNr.
view label notEmpty ifTrue:[
^ self labelMenu:sqNr
]
].
^ nil
!
labelMenu:anIndex
"popup menu required for a label identified by its sequence number
"
|menu|
menu := PopUpMenu labels:#(
'browse'
'browse class hierarchy'
'browse full class protocol'
)
selectors:#(
browse:
browseClassHierarchy:
browseFullClassProtocol:
)
receiver:self.
menu args:(Array new:(menu labels size) withAll:anIndex).
^ menu
! !
!InspectorPanelView methodsFor:'menu - views & actions'!
doTrace:anInstance
"place a trace on messages sent to the instance
"
|selectors|
selectors := self messageMenu:anInstance.
selectors notNil ifTrue:[
self topView withWaitCursorDo:[MessageTracer trace:anInstance selectors:selectors]
].
!
doTraceAll:anInstance
"place a trace on all messages sent to the instance
"
self topView withWaitCursorDo:[MessageTracer traceAll:anInstance]
!
doTrap:anInstance
"place a trap on a message sent to the instance
"
|selectors|
selectors := self messageMenu:anInstance.
selectors notNil ifTrue:[
self topView withWaitCursorDo:[MessageTracer trap:anInstance selectors:selectors]
]
!
doTrapAll:anInstance
"place a trap on all messages sent to the instance
"
self topView withWaitCursorDo:[MessageTracer trapAll:anInstance]
!
doUntrace:anInstance
"remove all traps and traces to the instance
"
self topView withWaitCursorDo:[MessageTracer untrace:anInstance].
!
messageMenu:anInstance
"open menu to select messages; on accepted a list of messages is returned
"
|sll acl lst inset top hzp slv acv dblClcAct btp b1 b2 accepted viewSpacing|
top := StandardSystemView new.
top extent:500 @ 400.
top label:(anInstance printString).
(Label origin:(0.0 @ 0.0) corner:(0.5 @ 20) in:top) label:'messages'.
(Label origin:(0.5 @ 0.0) corner:(1.0 @ 20) in:top) label:'selected'.
hzp := VariableHorizontalPanel origin:(0.0 @ 20) corner:(1.0 @ 1.0) in:top.
btp := HorizontalPanelView origin:(0.0 @1.0) corner:(1.0 @ 1.0) in:top.
b1 := Button abortButtonIn:btp.
b2 := Button okButtonIn:btp.
accepted := false.
b1 action:[accepted := false. top destroy].
b2 action:[accepted := true. top destroy].
btp horizontalLayout:#fitSpace.
viewSpacing := top class viewSpacing.
inset := (b2 preferredExtent y) + viewSpacing.
viewSpacing := viewSpacing // 2.
hzp bottomInset:inset.
btp topInset:((inset - viewSpacing) negated).
btp bottomInset:viewSpacing.
slv := ScrollableView for:SelectionInListView
miniScrollerV:true
origin:(0.0 @ 0.0)
corner:(0.5 @ 1.0)
in:hzp.
acv := ScrollableView for:SelectionInListView
miniScrollerV:true
origin:(0.5 @ 0.0)
corner:(1.0 @ 1.0)
in:hzp.
slv := slv scrolledView.
acv := acv scrolledView.
sll := (MessageTracer realClassOf:anInstance) selectors.
acl := OrderedCollection new.
(MessageTracer wrappedSelectorsOf:anInstance) do:[:el|
el notNil ifTrue:[
acl add:el.
sll remove:el ifAbsent:nil
]
].
slv list:(sll copy).
acv list:(acl copy).
dblClcAct := [:from :to|
to add:(from selectionValue).
from removeIndex:(from selection).
from redraw.
].
slv doubleClickAction:[:index| dblClcAct value:slv value:acv].
acv doubleClickAction:[:index| dblClcAct value:acv value:slv].
top openModal.
accepted ifFalse:[
^ nil
].
lst := acv list.
"undo existing traps HACK: removes traps and traces"
acl notEmpty ifTrue:[
MessageTracer untrace:anInstance
].
lst notEmpty ifTrue:[^ lst]
ifFalse:[^ nil]
!
viewMenu
"popup menu required by any view. Delegate the request to the corresponding view
"
|sqNr view|
view := (WindowGroup lastEventQuerySignal raise) view.
sqNr := listViews findFirst:[:v| v == view].
sqNr notNil ifTrue:[^ self viewMenu:sqNr]
ifFalse:[^ nil]
!
viewMenu:anIndex
"popup menu required for a view identified by its sequence number
"
|view menu inst args lbls|
view := listViews at:anIndex.
view hasSelection ifFalse:[^ nil].
inst := view selectedInstanceVar.
menu := PopUpMenu labels:#( 'update' )
selectors:#( #update )
receiver:self.
menu actionAt:#update put:[
view update.
listViews from:(anIndex + 1) do:[:v|
(view selectedInstanceType) ~~ #directory ifTrue:[
v inspect:nil
] ifFalse:[
v inspect:(view selectedInstanceVar).
view := v.
]
].
self update
].
(InspectorList isTraceable:inst) ifFalse:[
^ menu
].
menu addLabels:#(
'-'
'trace'
'trap'
'untrace / untrap'
)
selectors:#(
nil
trace
trap
untrace
).
menu actionAt:#untrace put:[self doUntrace:inst].
args := Array new:2 withAll:inst.
lbls := Array with:'message'
with:((Text string:' all ' emphasis:#underline), ' messages').
menu subMenuAt:#trace put:(
PopUpMenu labels:lbls selectors:#(doTrace: doTraceAll:) args:args
).
menu subMenuAt:#trap put:(
PopUpMenu labels:lbls selectors:#(doTrap: doTrapAll:) args:args
).
^ menu
! !
!InspectorPanelView methodsFor:'private'!
doItOrAccept:aBlock
"handle a doIt or accept action; on success all the folloed views are
updated
"
|index list result instVar|
list := self findLastValidListWithSelection.
result := aBlock value:list.
instVar := list selectedInstanceVar.
index := listViews findLast:[:v|v == list].
(index ~~ 0 and:[index ~~ listViews size]) ifTrue:[
index := index + 1.
(list selectedInstanceType) == #directory ifTrue:[
(listViews at:index) inspect:instVar
] ifFalse:[
(listViews at:index) inspect:nil
].
self update
].
valueChangedAction notNil ifTrue:[
valueChangedAction value:instVar
].
^ result
!
findLastValidListWithSelection
"returns last valid list with a selection; if no selection exists in any
view, the list assigned to the inspected object is returned
"
|index|
rightHistory notEmpty ifTrue:[
^ rightHistory first
].
index := listViews findLast:[:v| v hasSelection ].
index ~~ 0 ifTrue:[
^ listViews at:index
].
leftHistory notEmpty ifTrue:[^ leftHistory last]
ifFalse:[^ listViews at:1]
!
update
"update labels and scrollbar
"
|pview cview stop index ispObj label|
"UPDATE LABELS
"
index := 1.
stop := listViews size.
[ cview := listViews at:index.
ispObj := cview inspectedObject.
label := labelViews at:index.
index := index + 1.
ispObj notNil ifTrue:[
label label:(ispObj class name asString).
pview := cview.
] ifFalse:[
[index <= stop] whileTrue:[
(labelViews at:index) label:''.
index := index + 1
].
(pview isNil or:[pview selectedInstanceType == #normal]) ifTrue:[
pview notNil ifTrue:[ispObj := pview selectedInstanceVar].
label label:ispObj class name asString
] ifFalse:[
label label:''
]
].
index > stop
] whileFalse.
"UPDATE SCROLLBARS
"
index := listViews size + leftHistory size + rightHistory size.
(listViews last) selectedInstanceType notNil ifTrue:[
index := index + 1
].
scrollBar thumbHeight:(stop / index) * 100.
scrollBar thumbOrigin:(100 / index * leftHistory size).
! !
!InspectorPanelView methodsFor:'private frames'!
computeExtentOfFrames
"compute the extent of all frames (origin/corner)
"
|orig corn offset newX|
orig := ( 0.0 @ 0.0 ).
corn := ( 0.0 @ 1.0 ).
offset := 1.0 / (frames size).
newX := 0.0.
frames do:[:frame|
(newX := newX + offset) > 1.0 ifTrue:[ newX := 1.0 ].
corn := newX @ corn y.
frame origin:orig corner:corn.
orig := newX @ orig y.
].
!
createViewWithoutRedraw
"add a new view at end of the panel
"
|view frame label index|
frame := SimpleView in:hzpView.
label := Label origin:0.0@0.0 corner:1.0@20 in:frame.
label leftInset:15.
label rightInset:2.
view := ScrollableView for:InspectorListView miniScroller:true origin:0.0@20
corner:1.0@1.0 in:frame.
view := view scrolledView.
frames add:frame.
labelViews add:label.
listViews add:view.
index := listViews size.
index == 1 ifTrue:[
view includesSelf:true
].
label adjust:#left.
label label:''.
label level:1.
label menuHolder:self; menuMessage:#labelMenu; menuPerformer:self.
view action:[:el|self singleClickAt:index].
view delegate:self.
view menuHolder:self; menuMessage:#viewMenu; menuPerformer:self.
! !
!InspectorPanelView methodsFor:'scrolling-basic'!
moveContentsLeft:nTimes
"move the contents of all views one position left
"
|fView stop pView index|
(nTimes < 1 or:[listViews last isEmpty]) ifTrue:[
^ self
].
index := nTimes.
stop := (listViews size) - 1.
fView := listViews first.
pView := listViews at:stop.
[ leftHistory add:(fView list).
1 to:stop do:[:i|
(listViews at:i) list:(listViews at:(i+1))
].
rightHistory notEmpty ifTrue:[
(listViews last) list:(rightHistory removeLast)
] ifFalse:[
(listViews last) inspect:(pView selectedInstanceVar)
].
((index := index - 1) == 0 or:[listViews last isEmpty])
] whileFalse.
self update.
!
moveContentsRight:nTimes
"move the contents of all views one position right
"
|size index lView fView|
size := leftHistory size.
(nTimes > 0 and:[size ~~ 0]) ifTrue:[
nTimes > size ifFalse:[index := nTimes]
ifTrue:[index := size].
size := listViews size.
lView := listViews last.
fView := listViews first.
1 to:index do:[:i|
lView hasSelection ifTrue:[
rightHistory add:(lView list)
].
size to:2 by:-1 do:[:i|
(listViews at:i) list:(listViews at:(i-1))
].
fView list:(leftHistory removeLast)
].
self update
]
!
scrollTo:nPercent
"set views and contents dependant on scroll bar
"
|dY no noScr pR|
noScr := listViews size + leftHistory size + rightHistory size.
(listViews last) selectedInstanceType notNil ifTrue:[
noScr := noScr + 1
].
dY := 100 / noScr.
pR := nPercent roundTo:dY.
no := ((dY * leftHistory size) - pR) / dY.
no == 0 ifTrue:[
(nPercent - pR) > 0 ifTrue:[no := -1]
ifFalse:[no := 1]
].
no < 0 ifTrue:[self moveContentsLeft:(no negated)]
ifFalse:[self moveContentsRight:no]
! !
!InspectorPanelView class methodsFor:'documentation'!
version
^ '$Header$'
! !