# HG changeset patch # User ca # Date 853174156 -3600 # Node ID 6f1565819b63646feeec091bd65f3b16c5f5c717 # Parent 0f083a268b66aa58bfb48053375b0661f860a866 intitial checkin diff -r 0f083a268b66 -r 6f1565819b63 InspectorPanelView.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/InspectorPanelView.st Mon Jan 13 17:49:16 1997 +0100 @@ -0,0 +1,782 @@ +"{ 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 + ========= + + |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. + + + example 2 + ========= + + |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. + + + +" +! ! + +!InspectorPanelView class methodsFor:'constants'! + +minDepth + "returns the maximum of views + " + ^ 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 + " + |i el| + + rightHistory notEmpty ifTrue:[ + el := rightHistory last + ] ifFalse:[ + el := listViews findLast:[:v|v hasSelection]. + el := listViews at:el. + ]. + ^ el inspectedObject +! + +selectedInstanceVar + "returns the current selected instance var + " + |el| + + rightHistory notEmpty ifTrue:[ + el := rightHistory last + ] ifFalse:[ + el := listViews findLast:[:v|v hasSelection]. + el := listViews at:el + ]. + ^ el selectedInstanceVar +! ! + +!InspectorPanelView methodsFor:'actions'! + +accept:aText notifying:aView + self doItOrAccept:[:v|v accept:aText notifying:aView] +! + +doIt:aCode notifying:aView + ^ self doItOrAccept:[:v|v doIt:aCode notifying:aView] +! + +inspect:anObject + "change the inspected object + " + |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 + ^ true + +! + +keyPress:key x:x y:y view:someView + + key == #CursorLeft ifTrue:[^ self moveContentsRight:1]. + key == #CursorRight ifTrue:[^ self moveContentsLeft:1 ]. + + someView keyPress:key x:x y:y. + +! + +singleClickAt:anIndex + "the view 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 txt| + + view := listViews at:anIndex. + view hasSelection ifFalse:[^ nil]. + inst := view selectedInstanceVar. + + menu := PopUpMenu labels:#( 'update' '-') + selectors:#( #update nil) + receiver:self. + + menu actionAt:#update put:[ + view updateList. + + listViews from:(anIndex + 1) do:[:v| + (view selectedInstanceType) ~~ #directory ifTrue:[ + v inspect:nil + ] ifFalse:[ + v inspect:(view selectedInstanceVar). + view := v. + ] + ]. + self update + ]. + + menu addLabels:#( + 'trace' + 'trap' + 'untrace / untrap' + ) + selectors:#( + 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 + " + |index view ivar rslt last stop| + + last := listViews last. + self moveContentsLeft:(rightHistory size). + + last hasSelection ifTrue:[ + self moveContentsLeft:1. + index := (listViews size) - 1 + ] ifFalse:[ + index := listViews findLast:[:v|v hasSelection]. + ]. + + index ~~ 0 ifTrue:[ + view := listViews at:index. + rslt := aBlock value:view. + stop := listViews size. + ivar := view selectedInstanceVar. + + index == stop ifTrue:[ + self moveContentsLeft:1. + ] ifFalse:[ + index := index + 1. + + (view selectedInstanceType) == #directory ifTrue:[ + (listViews at:index) inspect:ivar + ] ifFalse:[ + (listViews at:index) inspect:nil + ]. + self update. + ]. + + valueChangedAction notNil ifTrue:[ + valueChangedAction value:ivar + ] + ]. + ^ rslt +! + +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 + " + |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 each view one position left + " + |fView stop assoc inspObj 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 listHolder. + + 1 to:stop do:[:i| + (listViews at:i) updateFromView:(listViews at:(i+1)) + ]. + + rightHistory notEmpty ifTrue:[ + (listViews last) updateFromList:(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 listViews one position right + " + |view assoc 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 listHolder) + ]. + size to:2 by:-1 do:[:i| + (listViews at:i) updateFromView:(listViews at:(i-1)) + ]. + fView updateFromList:(leftHistory removeLast) + ]. + self update + ] + +! + +scrollTo:nPercent + "set views 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$' +! ! diff -r 0f083a268b66 -r 6f1565819b63 NewInspectorPanelView.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/NewInspectorPanelView.st Mon Jan 13 17:49:16 1997 +0100 @@ -0,0 +1,782 @@ +"{ 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 + ========= + + |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. + + + example 2 + ========= + + |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. + + + +" +! ! + +!InspectorPanelView class methodsFor:'constants'! + +minDepth + "returns the maximum of views + " + ^ 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 + " + |i el| + + rightHistory notEmpty ifTrue:[ + el := rightHistory last + ] ifFalse:[ + el := listViews findLast:[:v|v hasSelection]. + el := listViews at:el. + ]. + ^ el inspectedObject +! + +selectedInstanceVar + "returns the current selected instance var + " + |el| + + rightHistory notEmpty ifTrue:[ + el := rightHistory last + ] ifFalse:[ + el := listViews findLast:[:v|v hasSelection]. + el := listViews at:el + ]. + ^ el selectedInstanceVar +! ! + +!InspectorPanelView methodsFor:'actions'! + +accept:aText notifying:aView + self doItOrAccept:[:v|v accept:aText notifying:aView] +! + +doIt:aCode notifying:aView + ^ self doItOrAccept:[:v|v doIt:aCode notifying:aView] +! + +inspect:anObject + "change the inspected object + " + |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 + ^ true + +! + +keyPress:key x:x y:y view:someView + + key == #CursorLeft ifTrue:[^ self moveContentsRight:1]. + key == #CursorRight ifTrue:[^ self moveContentsLeft:1 ]. + + someView keyPress:key x:x y:y. + +! + +singleClickAt:anIndex + "the view 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 txt| + + view := listViews at:anIndex. + view hasSelection ifFalse:[^ nil]. + inst := view selectedInstanceVar. + + menu := PopUpMenu labels:#( 'update' '-') + selectors:#( #update nil) + receiver:self. + + menu actionAt:#update put:[ + view updateList. + + listViews from:(anIndex + 1) do:[:v| + (view selectedInstanceType) ~~ #directory ifTrue:[ + v inspect:nil + ] ifFalse:[ + v inspect:(view selectedInstanceVar). + view := v. + ] + ]. + self update + ]. + + menu addLabels:#( + 'trace' + 'trap' + 'untrace / untrap' + ) + selectors:#( + 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 + " + |index view ivar rslt last stop| + + last := listViews last. + self moveContentsLeft:(rightHistory size). + + last hasSelection ifTrue:[ + self moveContentsLeft:1. + index := (listViews size) - 1 + ] ifFalse:[ + index := listViews findLast:[:v|v hasSelection]. + ]. + + index ~~ 0 ifTrue:[ + view := listViews at:index. + rslt := aBlock value:view. + stop := listViews size. + ivar := view selectedInstanceVar. + + index == stop ifTrue:[ + self moveContentsLeft:1. + ] ifFalse:[ + index := index + 1. + + (view selectedInstanceType) == #directory ifTrue:[ + (listViews at:index) inspect:ivar + ] ifFalse:[ + (listViews at:index) inspect:nil + ]. + self update. + ]. + + valueChangedAction notNil ifTrue:[ + valueChangedAction value:ivar + ] + ]. + ^ rslt +! + +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 + " + |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 each view one position left + " + |fView stop assoc inspObj 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 listHolder. + + 1 to:stop do:[:i| + (listViews at:i) updateFromView:(listViews at:(i+1)) + ]. + + rightHistory notEmpty ifTrue:[ + (listViews last) updateFromList:(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 listViews one position right + " + |view assoc 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 listHolder) + ]. + size to:2 by:-1 do:[:i| + (listViews at:i) updateFromView:(listViews at:(i-1)) + ]. + fView updateFromList:(leftHistory removeLast) + ]. + self update + ] + +! + +scrollTo:nPercent + "set views 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$' +! !