# HG changeset patch # User Claus Gittinger # Date 1255520607 -7200 # Node ID 285fa261cbcb8817da668a26f5be0cc1fd862786 # Parent fccbd77a9409e2ac335b78772f7c0bb87e9ee83e *** empty log message *** diff -r fccbd77a9409 -r 285fa261cbcb NewInspectorList.st --- a/NewInspectorList.st Wed Oct 14 08:13:10 2009 +0200 +++ b/NewInspectorList.st Wed Oct 14 13:43:27 2009 +0200 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -11,7 +11,7 @@ " -"{ NameSpace: NewInspector }" +"{ NameSpace: Tools }" Object subclass:#NewInspectorList instanceVariableNames:'inspectedObject instanceNames instanceTypes selection' @@ -25,7 +25,7 @@ copyright " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -64,19 +64,19 @@ |string| aCollection isCollection ifTrue:[ - aCollection isString ifTrue:[ - string := aCollection - ] ifFalse:[ - string := aCollection asStringWith:Character space - from:1 to:(aCollection size) - compressTabs:true - final:nil - ]. - string := string withoutSeparators. + aCollection isString ifTrue:[ + string := aCollection + ] ifFalse:[ + string := aCollection asStringWith:Character space + from:1 to:(aCollection size) + compressTabs:true + final:nil + ]. + string := string withoutSeparators. - string notEmpty ifTrue:[ - ^ string - ] + string notEmpty ifTrue:[ + ^ string + ] ]. ^ nil @@ -91,21 +91,21 @@ |cls| anInstance notNil ifTrue:[ - cls := anInstance class. + cls := anInstance class. - cls == Character ifTrue:[ ^ false ]. - cls == Symbol ifTrue:[ ^ false ]. - cls == String ifTrue:[ ^ false ]. - cls == Float ifTrue:[ ^ false ]. - cls == ShortFloat ifTrue:[ ^ false ]. + cls == Character ifTrue:[ ^ false ]. + cls == Symbol ifTrue:[ ^ false ]. + cls == String ifTrue:[ ^ false ]. + cls == Float ifTrue:[ ^ false ]. + cls == ShortFloat ifTrue:[ ^ false ]. - cls allInstVarNames notEmpty ifTrue:[ - ^ true - ]. + cls allInstVarNames notEmpty ifTrue:[ + ^ true + ]. - anInstance isVariable ifTrue:[ - ^ true - ]. + anInstance isVariable ifTrue:[ + ^ true + ]. ]. ^ false @@ -118,12 +118,12 @@ |cls| anInstance notNil ifTrue:[ - cls := anInstance class. + cls := anInstance class. ^ ( cls ~~ True - and:[cls ~~ False - and:[cls ~~ SmallInteger]] - ) + and:[cls ~~ False + and:[cls ~~ SmallInteger]] + ) ]. ^ false. @@ -135,23 +135,23 @@ "includes 'self' dependant on the boolean " (self includesSelf) ~~ aBoolean ifTrue:[ - aBoolean ifTrue:[ - instanceNames addFirst:'self'. - instanceTypes addFirst:#self. + aBoolean ifTrue:[ + instanceNames addFirst:'self'. + instanceTypes addFirst:#self. - selection notNil ifTrue:[selection := selection + 1] - ifFalse:[selection := 1] + selection notNil ifTrue:[selection := selection + 1] + ifFalse:[selection := 1] - ] ifFalse:[ - instanceNames removeFirst. - instanceTypes removeFirst. + ] ifFalse:[ + instanceNames removeFirst. + instanceTypes removeFirst. - selection isNil ifFalse:[ - (selection := selection - 1) == 0 ifTrue:[ - selection := nil - ] - ] - ] + selection isNil ifFalse:[ + (selection := selection - 1) == 0 ifTrue:[ + selection := nil + ] + ] + ] ] @@ -176,19 +176,19 @@ |start stop size| inspectedObject isVariable ifTrue:[ - start := instanceNames findFirst:[:el|(el at:1) isDigit]. - stop := instanceTypes size. + start := instanceNames findFirst:[:el|(el at:1) isDigit]. + stop := instanceTypes size. - start == 0 ifTrue:[ - size := stop + 10. "must be > 1: force a resize the first time" - ] ifFalse:[ - instanceTypes last ~~ #grow ifTrue:[size := stop] - ifFalse:[size := stop-1]. + start == 0 ifTrue:[ + size := stop + 10. "must be > 1: force a resize the first time" + ] ifFalse:[ + instanceTypes last ~~ #grow ifTrue:[size := stop] + ifFalse:[size := stop-1]. - instanceTypes removeFromIndex:start toIndex:stop. - instanceNames removeFromIndex:start toIndex:stop. - ]. - self resizeTo:size. + instanceTypes removeFromIndex:start toIndex:stop. + instanceNames removeFromIndex:start toIndex:stop. + ]. + self resizeTo:size. ] "Modified: / 4.2.1999 / 20:00:38 / cg" @@ -217,7 +217,7 @@ In case of an invalid index nil is returned. " (anIndex isNil or:[anIndex > instanceTypes size]) ifFalse:[^ instanceTypes at:anIndex] - ifTrue:[^ nil]. + ifTrue:[^ nil]. ! @@ -231,21 +231,21 @@ ! instanceVarAt:anIndex - "returns the instnace variable assigned to the index or + "returns the instnace variable assigned to the index or nil in case of an invalid index. " |nm| (anIndex isNil or:[anIndex > instanceTypes size]) ifFalse:[ - nm := instanceNames at:anIndex. + nm := instanceNames at:anIndex. - (nm at:1) isDigit ifFalse:[ - self includesSelf ifFalse:[ - ^ inspectedObject instVarAt:anIndex - ]. - anIndex == 1 ifFalse:[^ inspectedObject instVarAt:(anIndex-1)] - ifTrue:[^ inspectedObject] - ]. + (nm at:1) isDigit ifFalse:[ + self includesSelf ifFalse:[ + ^ inspectedObject instVarAt:anIndex + ]. + anIndex == 1 ifFalse:[^ inspectedObject instVarAt:(anIndex-1)] + ifTrue:[^ inspectedObject] + ]. ^ inspectedObject basicAt:(Number readFrom:nm onError:0) ]. ^ nil @@ -273,46 +273,46 @@ |lstVarId basicSize newLastId obj instSize| (inspectedObject isVariable and:[self class isDirectory:inspectedObject]) ifFalse:[ - ^ self + ^ self ]. instanceTypes size == 0 ifTrue:[ - lstVarId := 0 + lstVarId := 0 ] ifFalse:[ - instSize := inspectedObject class instSize. + instSize := inspectedObject class instSize. - instanceTypes first == #self ifTrue:[ - instSize := instSize + 1 - ]. - instanceTypes last == #grow ifTrue:[ - instanceNames removeLast. " .. " - instanceTypes removeLast. " #grow " - ]. - lstVarId := instanceTypes size - instSize. + instanceTypes first == #self ifTrue:[ + instSize := instSize + 1 + ]. + instanceTypes last == #grow ifTrue:[ + instanceNames removeLast. " .. " + instanceTypes removeLast. " #grow " + ]. + lstVarId := instanceTypes size - instSize. ]. (basicSize := inspectedObject basicSize) == lstVarId ifTrue:[ - ^ self + ^ self ]. newLastId := (1 bitShift:((aNumber-1) highBit)) max:128. (newLastId + 64) > basicSize ifTrue:[ - newLastId := basicSize + newLastId := basicSize ]. [lstVarId ~~ newLastId] whileTrue:[ - lstVarId := lstVarId + 1. - obj := inspectedObject basicAt:lstVarId. + lstVarId := lstVarId + 1. + obj := inspectedObject basicAt:lstVarId. - (self class isDirectory:obj) ifTrue:[instanceTypes add:#directory] - ifFalse:[instanceTypes add:#normal]. + (self class isDirectory:obj) ifTrue:[instanceTypes add:#directory] + ifFalse:[instanceTypes add:#normal]. - instanceNames add:(lstVarId printString, ' ', obj class name printString). + instanceNames add:(lstVarId printString, ' ', obj class name printString). ]. lstVarId ~~ basicSize ifTrue:[ - instanceNames add:'..'. - instanceTypes add:#grow + instanceNames add:'..'. + instanceTypes add:#grow ]. ! ! @@ -349,12 +349,12 @@ selection := aNrOrNil. (selection isNil or:[instanceTypes size > selection]) ifFalse:[ - self resizeTo:selection. + self resizeTo:selection. - selection > instanceTypes size ifTrue:[ - selection := nil - ] - ] + selection > instanceTypes size ifTrue:[ + selection := nil + ] + ] ! ! !NewInspectorList methodsFor:'testing'! @@ -391,33 +391,33 @@ |text slNr value| selection notNil ifTrue:[ - text := self class asString:aText. + text := self class asString:aText. - text notNil ifTrue:[ - self includesSelf ifFalse:[slNr := selection] - ifTrue:[slNr := selection-1]. + text notNil ifTrue:[ + self includesSelf ifFalse:[slNr := selection] + ifTrue:[slNr := selection-1]. - value := inspectedObject class evaluatorClass - evaluate:text - receiver:inspectedObject - notifying:aView. + value := inspectedObject class evaluatorClass + evaluate:text + receiver:inspectedObject + notifying:aView. - slNr ~~ 0 ifTrue:[ - (inspectedObject class isVariable) ifFalse:[ - inspectedObject instVarAt:slNr put:value - ] ifTrue:[ - slNr <= (inspectedObject class instSize) ifTrue:[ - inspectedObject instVarAt:slNr put:value - ] ifFalse:[ - slNr := slNr - inspectedObject class instSize. - inspectedObject basicAt:slNr put:value - ] - ] - ]. - inspectedObject changed. - self update. - ^ inspectedObject - ] + slNr ~~ 0 ifTrue:[ + (inspectedObject class isVariable) ifFalse:[ + inspectedObject instVarAt:slNr put:value + ] ifTrue:[ + slNr <= (inspectedObject class instSize) ifTrue:[ + inspectedObject instVarAt:slNr put:value + ] ifFalse:[ + slNr := slNr - inspectedObject class instSize. + inspectedObject basicAt:slNr put:value + ] + ] + ]. + inspectedObject changed. + self update. + ^ inspectedObject + ] ]. ^ #Error ! @@ -432,26 +432,26 @@ selInstVar := self selectedInstanceVar. selInstVar notNil ifTrue:[ - code := self class asString:aCode. + code := self class asString:aCode. - code notNil ifTrue:[ - evaluator := selInstVar class evaluatorClass. - successFg := true. + code notNil ifTrue:[ + evaluator := selInstVar class evaluatorClass. + successFg := true. - evaluator notNil ifTrue:[ - result := evaluator evaluate:code - in:nil - receiver:selInstVar - notifying:aView - logged:true - ifFail:[successFg := false]. + evaluator notNil ifTrue:[ + result := evaluator evaluate:code + in:nil + receiver:selInstVar + notifying:aView + logged:true + ifFail:[successFg := false]. - successFg ifTrue:[ - self update. - ^ result - ] - ] - ] + successFg ifTrue:[ + self update. + ^ result + ] + ] + ] ]. ^ #Error. @@ -466,24 +466,24 @@ selection := nil. anObject == inspectedObject ifFalse:[ - inspectedObject := anObject. + inspectedObject := anObject. - (self class isDirectory:inspectedObject) ifFalse:[ - instanceNames := OrderedCollection new. - instanceTypes := OrderedCollection new. - ] ifTrue:[ - instanceNames := inspectedObject class allInstVarNames. - varNamesSize := instanceNames size. - instanceTypes := OrderedCollection new:varNamesSize. + (self class isDirectory:inspectedObject) ifFalse:[ + instanceNames := OrderedCollection new. + instanceTypes := OrderedCollection new. + ] ifTrue:[ + instanceNames := inspectedObject class allInstVarNames. + varNamesSize := instanceNames size. + instanceTypes := OrderedCollection new:varNamesSize. - 1 to:varNamesSize do:[:i| - (self class isDirectory:(inspectedObject instVarAt:i)) ifTrue:[ - instanceTypes add:#directory - ] ifFalse:[ - instanceTypes add:#normal - ] - ]. - ] + 1 to:varNamesSize do:[:i| + (self class isDirectory:(inspectedObject instVarAt:i)) ifTrue:[ + instanceTypes add:#directory + ] ifFalse:[ + instanceTypes add:#normal + ] + ]. + ] ]. self update ! ! diff -r fccbd77a9409 -r 285fa261cbcb NewInspectorListView.st --- a/NewInspectorListView.st Wed Oct 14 08:13:10 2009 +0200 +++ b/NewInspectorListView.st Wed Oct 14 13:43:27 2009 +0200 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -12,7 +12,7 @@ -"{ NameSpace: NewInspector }" +"{ NameSpace: Tools }" SelectionInListView subclass:#NewInspectorListView instanceVariableNames:'actionHolder inspectorList includesSelf' @@ -26,7 +26,7 @@ copyright " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -41,24 +41,24 @@ examples " - open a list view on an instance - [exBegin] - |top slv a| + open a list view on an instance + [exBegin] + |top slv a| - a := OrderedCollection new. - a add:1. + a := OrderedCollection new. + a add:1. - top := StandardSystemView new - label:'select'; - extent:200@200. + top := StandardSystemView new + label:'select'; + extent:200@200. - slv := ScrollableView for:self in:top. - slv origin:0.0@0.0 corner:1.0@1.0. - slv := slv scrolledView. - slv inspect:top. - slv action:[:el|Transcript showCR:(el printString)]. - top open - [exEnd] + slv := ScrollableView for:self in:top. + slv origin:0.0@0.0 corner:1.0@1.0. + slv := slv scrolledView. + slv inspect:top. + slv action:[:el|Transcript showCR:(el printString)]. + top open + [exEnd] " ! ! @@ -76,7 +76,7 @@ "set the lists contents from another list " aList notNil ifTrue:[inspectorList := aList list] - ifFalse:[inspectorList := NewInspectorList new]. + ifFalse:[inspectorList := NewInspectorList new]. inspectorList includesSelf:includesSelf. super list:(inspectorList instanceNames). @@ -104,10 +104,10 @@ drawVisibleLineSelected:visLineNr with:fg and:bg "redraw a single line as selected. " - |nr| + |nr| (nr := self visibleLineToListLine:visLineNr) notNil ifTrue:[ - ^ self drawVisibleLine:visLineNr with:fg and:bg. + ^ self drawVisibleLine:visLineNr with:fg and:bg. ]. ^ super drawVisibleLine:visLineNr with:fg and:bg @@ -121,7 +121,7 @@ nr := self visibleLineToListLine:visLineNr. (inspectorList instanceTypeAt:nr) == #directory ifTrue:[ - self drawRightArrowInVisibleLine:visLineNr + self drawRightArrowInVisibleLine:visLineNr ] @@ -133,7 +133,7 @@ super redrawFromVisibleLine:startVisLineNr to:endVisLineNr. startVisLineNr to:endVisLineNr do:[:visLineNr| - self redrawArrowVisibleLine:visLineNr + self redrawArrowVisibleLine:visLineNr ] ! @@ -152,7 +152,7 @@ nr := self visibleLineToListLine:visLineNr. (inspectorList instanceTypeAt:nr) == #directory ifTrue:[ - ^ true + ^ true ]. ^ super visibleLineNeedsSpecialCare:visLineNr @@ -190,8 +190,8 @@ inspectorList := NewInspectorList new. actionBlock := [:dummy| - self setSelection:selection. - actionHolder value:(self selectedInstanceVar) + self setSelection:selection. + actionHolder value:(self selectedInstanceVar) ]. ! ! @@ -201,7 +201,7 @@ "forward a message to the inspectorList " (inspectorList respondsTo:(aMessage selector)) ifTrue:[ - ^ aMessage sendTo:inspectorList + ^ aMessage sendTo:inspectorList ]. ^ super doesNotUnderstand:aMessage @@ -216,12 +216,12 @@ we have to remove the highlight frame by hand here" (shown and:[hilightLevel ~~ 0]) ifTrue:[ - selection == firstLineShown ifTrue:[ - self paint:bgColor. - self fillRectangleX:margin y:margin - width:(width - (margin * 2)) - height:(hilightLevel abs). - ]. + selection == firstLineShown ifTrue:[ + self paint:bgColor. + self fillRectangleX:margin y:margin + width:(width - (margin * 2)) + height:(hilightLevel abs). + ]. ]. listAttributes := nil. super list:aCollection expandTabs:false. @@ -242,7 +242,7 @@ oldSize := inspectorList size. inspectorList setSelection:aNumberOrNil. oldSize == inspectorList size ifTrue:[super setSelection:(inspectorList selection)] - ifFalse:[super list:(inspectorList instanceNames)]. + ifFalse:[super list:(inspectorList instanceNames)]. ! ! !NewInspectorListView methodsFor:'user interaction'! @@ -257,7 +257,7 @@ res := inspectorList accept:aText notifying:aView. res ~~ #Error ifTrue:[ - super list:(inspectorList instanceNames) + super list:(inspectorList instanceNames) ]. ^ res ! @@ -272,7 +272,7 @@ res := inspectorList doIt:aCode notifying:aView. res ~~ #Error ifTrue:[ - super list:(inspectorList instanceNames) + super list:(inspectorList instanceNames) ]. ^ res @@ -282,7 +282,7 @@ "inspect a new instance; update contents " (inspectorList inspectedObject) == anObject ifTrue:[ - ^ self update + ^ self update ]. inspectorList := NewInspectorList for:anObject. inspectorList includesSelf:includesSelf. diff -r fccbd77a9409 -r 285fa261cbcb NewInspectorPanelView.st --- a/NewInspectorPanelView.st Wed Oct 14 08:13:10 2009 +0200 +++ b/NewInspectorPanelView.st Wed Oct 14 13:43:27 2009 +0200 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -11,7 +11,7 @@ " "{ Package: 'stx:libtool2' }" -"{ NameSpace: NewInspector }" +"{ NameSpace: Tools }" SimpleView subclass:#NewInspectorPanelView instanceVariableNames:'frames labelViews listViews scrollBar maxDepth leftHistory @@ -26,7 +26,7 @@ copyright " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -44,20 +44,20 @@ example 1 ========= - [exBegin] + [exBegin] |top slv| top := StandardSystemView new extent:600@400. - slv := NewInspector::NewInspectorPanelView origin:0.0@0.0 corner:1.0@1.0 in:top. + slv := Tools::NewInspectorPanelView origin:0.0@0.0 corner:1.0@1.0 in:top. slv inspect:top. slv action:[:el|Transcript showCR:el]. top open. - [exEnd] + [exEnd] example 2 ========= - [exBegin] + [exBegin] |top slv edt a vvp| a := Array new:5. @@ -66,7 +66,7 @@ top := StandardSystemView new extent:600@400. vvp := VariableVerticalPanel origin:0.0@0.0 corner:1.0@1.0 in:top. - slv := NewInspector::NewInspectorPanelView origin:0.0@0.0 corner:1.0@0.5 in:vvp. + slv := Tools::NewInspectorPanelView 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]. @@ -75,7 +75,7 @@ slv inspect:a. top open. - [exEnd] + [exEnd] " ! ! @@ -103,25 +103,25 @@ min := self class minDepth. aDepth > min ifTrue:[ - sz := aDepth min:maxDepth. + sz := aDepth min:maxDepth. - sz < listViews size ifTrue:[ - sz := listViews size - ] + sz < listViews size ifTrue:[ + sz := listViews size + ] ] ifFalse:[ - sz := min + sz := min ]. listViews size == sz ifTrue:[ - sz == aDepth ifFalse:[self moveContentsLeft:1]. + sz == aDepth ifFalse:[self moveContentsLeft:1]. ] ifFalse:[ - [self createViewWithoutRedraw. listViews size ~~ sz] whileTrue. - self computeExtentOfFrames. + [self createViewWithoutRedraw. listViews size ~~ sz] whileTrue. + self computeExtentOfFrames. - (self topView shown) ifTrue:[ - hzpView sizeChanged:nil. - hzpView realizeAllSubViews. - ] + (self topView shown) ifTrue:[ + hzpView sizeChanged:nil. + hzpView realizeAllSubViews. + ] ] ! @@ -133,13 +133,13 @@ "change max depth for instance " aNumber > listViews size ifTrue:[ - aNumber >= (self class minDepth) ifTrue:[ - maxDepth := aNumber. + aNumber >= (self class minDepth) ifTrue:[ + maxDepth := aNumber. - maxDepth < listViews size ifTrue:[ - self depth:maxDepth - ] - ] + maxDepth < listViews size ifTrue:[ + self depth:maxDepth + ] + ] ] ! ! @@ -237,17 +237,17 @@ sivar := view selectedInstanceVar. start > listViews size ifTrue:[ - start >= maxDepth ifTrue:[ - self moveContentsLeft:1. - ^ actionBlock value:sivar. - ]. + 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 at:start) setSelection:nil. + (listViews at:start) inspect:sivar. + + start := start + 1. ]. listViews from:start do:[:v|v inspect:nil]. @@ -309,9 +309,9 @@ |cls| anIndex <= labelViews size ifTrue:[ - (cls := Smalltalk classNamed:((labelViews at:anIndex) label)) notNil ifTrue:[ - anAction value:cls - ] + (cls := Smalltalk classNamed:((labelViews at:anIndex) label)) notNil ifTrue:[ + anAction value:cls + ] ] ! @@ -325,11 +325,11 @@ sqNr := labelViews findFirst:[:v| v == view]. sqNr ~~ 0 ifTrue:[ - view := labelViews at:sqNr. + view := labelViews at:sqNr. - view label notEmpty ifTrue:[ - ^ self labelMenu:sqNr - ] + view label notEmpty ifTrue:[ + ^ self labelMenu:sqNr + ] ]. ^ nil ! @@ -340,16 +340,16 @@ |menu| menu := PopUpMenu labels:#( - 'browse' - 'browse class hierarchy' - 'browse full class protocol' - ) - selectors:#( - browse: - browseClassHierarchy: - browseFullClassProtocol: - ) - receiver:self. + 'browse' + 'browse class hierarchy' + 'browse full class protocol' + ) + selectors:#( + browse: + browseClassHierarchy: + browseFullClassProtocol: + ) + receiver:self. menu args:(Array new:(menu labels size) withAll:anIndex). ^ menu @@ -366,7 +366,7 @@ selectors := self messageMenu:anInstance. selectors notNil ifTrue:[ - self topView withWaitCursorDo:[MessageTracer trace:anInstance selectors:selectors] + self topView withWaitCursorDo:[MessageTracer trace:anInstance selectors:selectors] ]. ! @@ -385,7 +385,7 @@ selectors := self messageMenu:anInstance. selectors notNil ifTrue:[ - self topView withWaitCursorDo:[MessageTracer trap:anInstance selectors:selectors] + self topView withWaitCursorDo:[MessageTracer trap:anInstance selectors:selectors] ] ! @@ -434,16 +434,16 @@ btp bottomInset:viewSpacing. slv := ScrollableView for:SelectionInListView - miniScrollerV:true - origin:(0.0 @ 0.0) - corner:(0.5 @ 1.0) - in:hzp. + 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. + miniScrollerV:true + origin:(0.5 @ 0.0) + corner:(1.0 @ 1.0) + in:hzp. slv := slv scrolledView. acv := acv scrolledView. @@ -452,19 +452,19 @@ acl := OrderedCollection new. (MessageTracer wrappedSelectorsOf:anInstance) do:[:el| - el notNil ifTrue:[ - acl add:el. - sll remove:el ifAbsent:nil - ] + 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. + to add:(from selectionValue). + from removeIndex:(from selection). + from redraw. ]. slv doubleClickAction:[:index| dblClcAct value:slv value:acv]. @@ -473,18 +473,18 @@ top openModal. accepted ifFalse:[ - ^ nil + ^ nil ]. lst := acv list. "undo existing traps HACK: removes traps and traces" acl notEmpty ifTrue:[ - MessageTracer untrace:anInstance + MessageTracer untrace:anInstance ]. lst notEmpty ifTrue:[^ lst] - ifFalse:[^ nil] + ifFalse:[^ nil] ! viewMenu @@ -496,7 +496,7 @@ sqNr := listViews findFirst:[:v| v == view]. sqNr notNil ifTrue:[^ self viewMenu:sqNr] - ifFalse:[^ nil] + ifFalse:[^ nil] ! viewMenu:anIndex @@ -509,52 +509,52 @@ inst := view selectedInstanceVar. menu := PopUpMenu labels:#( 'update' ) - selectors:#( #update ) - receiver:self. + selectors:#( #update ) + receiver:self. menu actionAt:#update put:[ - view update. + view update. - listViews from:(anIndex + 1) do:[:v| - (view selectedInstanceType) ~~ #directory ifTrue:[ - v inspect:nil - ] ifFalse:[ - v inspect:(view selectedInstanceVar). - view := v. - ] - ]. - self update + listViews from:(anIndex + 1) do:[:v| + (view selectedInstanceType) ~~ #directory ifTrue:[ + v inspect:nil + ] ifFalse:[ + v inspect:(view selectedInstanceVar). + view := v. + ] + ]. + self update ]. (NewInspectorList isTraceable:inst) ifFalse:[ - ^ menu + ^ menu ]. menu addLabels:#( - '-' - 'trace' - 'trap' - 'untrace / untrap' - ) - selectors:#( - nil - trace - trap - untrace - ). + '-' + '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'). + with:((Text string:' all ' emphasis:#underline), ' messages'). menu subMenuAt:#trace put:( - PopUpMenu labels:lbls selectors:#(doTrace: doTraceAll:) args:args + PopUpMenu labels:lbls selectors:#(doTrace: doTraceAll:) args:args ). menu subMenuAt:#trap put:( - PopUpMenu labels:lbls selectors:#(doTrap: doTrapAll:) args:args + PopUpMenu labels:lbls selectors:#(doTrap: doTrapAll:) args:args ). ^ menu @@ -576,16 +576,16 @@ 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 + 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 + valueChangedAction value:instVar ]. ^ result ! @@ -597,16 +597,16 @@ |index| rightHistory notEmpty ifTrue:[ - ^ rightHistory first + ^ rightHistory first ]. index := listViews findLast:[:v| v hasSelection ]. index ~~ 0 ifTrue:[ - ^ listViews at:index + ^ listViews at:index ]. leftHistory notEmpty ifTrue:[^ leftHistory last] - ifFalse:[^ listViews at:1] + ifFalse:[^ listViews at:1] ! update @@ -620,27 +620,27 @@ stop := listViews size. [ cview := listViews at:index. - ispObj := cview inspectedObject. - label := labelViews at:index. - index := index + 1. + 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 - ]. + 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 + (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. @@ -649,7 +649,7 @@ index := listViews size + leftHistory size + rightHistory size. (listViews last) selectedInstanceType notNil ifTrue:[ - index := index + 1 + index := index + 1 ]. scrollBar thumbHeight:(stop / index) * 100. scrollBar thumbOrigin:(100 / index * leftHistory size). @@ -670,10 +670,10 @@ 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. + (newX := newX + offset) > 1.0 ifTrue:[ newX := 1.0 ]. + corn := newX @ corn y. + frame origin:orig corner:corn. + orig := newX @ orig y. ]. @@ -690,8 +690,8 @@ label leftInset:15. label rightInset:2. - view := ScrollableView for:NewInspectorListView miniScroller:true origin:0.0@20 - corner:1.0@1.0 in:frame. + view := ScrollableView for:NewInspectorListView miniScroller:true origin:0.0@20 + corner:1.0@1.0 in:frame. view := view scrolledView. @@ -702,7 +702,7 @@ index := listViews size. index == 1 ifTrue:[ - view includesSelf:true + view includesSelf:true ]. label adjust:#left. @@ -725,7 +725,7 @@ |fView stop pView index| (nTimes < 1 or:[listViews last isEmpty]) ifTrue:[ - ^ self + ^ self ]. index := nTimes. @@ -736,16 +736,16 @@ [ leftHistory add:(fView list). - 1 to:stop do:[:i| - (listViews at:i) list:(listViews at:(i+1)) - ]. + 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]) + rightHistory notEmpty ifTrue:[ + (listViews last) list:(rightHistory removeLast) + ] ifFalse:[ + (listViews last) inspect:(pView selectedInstanceVar) + ]. + ((index := index - 1) == 0 or:[listViews last isEmpty]) ] whileFalse. @@ -763,23 +763,23 @@ size := leftHistory size. (nTimes > 0 and:[size ~~ 0]) ifTrue:[ - nTimes > size ifFalse:[index := nTimes] - ifTrue:[index := size]. + nTimes > size ifFalse:[index := nTimes] + ifTrue:[index := size]. - size := listViews size. - lView := listViews last. - fView := listViews first. + 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 + 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 ] ! @@ -792,7 +792,7 @@ noScr := listViews size + leftHistory size + rightHistory size. (listViews last) selectedInstanceType notNil ifTrue:[ - noScr := noScr + 1 + noScr := noScr + 1 ]. dY := 100 / noScr. pR := nPercent roundTo:dY. @@ -800,11 +800,11 @@ no := ((dY * leftHistory size) - pR) / dY. no == 0 ifTrue:[ - (nPercent - pR) > 0 ifTrue:[no := -1] - ifFalse:[no := 1] + (nPercent - pR) > 0 ifTrue:[no := -1] + ifFalse:[no := 1] ]. no < 0 ifTrue:[self moveContentsLeft:(no negated)] - ifFalse:[self moveContentsRight:no] + ifFalse:[self moveContentsRight:no] ! ! !NewInspectorPanelView class methodsFor:'documentation'! diff -r fccbd77a9409 -r 285fa261cbcb NewInspectorView.st --- a/NewInspectorView.st Wed Oct 14 08:13:10 2009 +0200 +++ b/NewInspectorView.st Wed Oct 14 13:43:27 2009 +0200 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -11,7 +11,7 @@ " "{ Package: 'stx:libtool2' }" -"{ NameSpace: NewInspector }" +"{ NameSpace: Tools }" VariableVerticalPanel subclass:#NewInspectorView instanceVariableNames:'inspectorView userSpace workSpace inspectedObject' @@ -25,7 +25,7 @@ copyright " COPYRIGHT (c) 1997 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -42,17 +42,17 @@ " a new (multipane) inspector; open with: - NewInspector::NewInspectorView inspect:Object + Tools::NewInspectorView inspect:Object install as standard inspector: - Smalltalk at:#Inspector put:(NewInspector::NewInspectorView) + Smalltalk at:#Inspector put:(Tools::NewInspectorView) [open with:] - NewInspector::NewInspectorView - inspect:(Array with:#hello with:'hello' with:#(1 2 3) asSortedCollection with:Display) + Tools::NewInspectorView + inspect:(Array with:#hello with:'hello' with:#(1 2 3) asSortedCollection with:Display) [author:] - Claus Atzkern + Claus Atzkern " ! @@ -60,13 +60,13 @@ " open an inspector on an array - [exBegin] + [exBegin] |array| array := Array new:5. array at:1 put:(Array new:400). - NewInspector::NewInspectorView inspect:array - [exEnd] + Tools::NewInspectorView inspect:array + [exEnd] " ! ! @@ -129,7 +129,7 @@ inspectorView action:[:el|self updateWorkSpace]. inspectorView valueChangedAction:[:el||lbl| - workSpace list:(Array with:(el displayString)). + workSpace list:(Array with:(el displayString)). ]. "Modified: 18.3.1997 / 10:57:34 / cg" diff -r fccbd77a9409 -r 285fa261cbcb stx_libtool2.st --- a/stx_libtool2.st Wed Oct 14 08:13:10 2009 +0200 +++ b/stx_libtool2.st Wed Oct 14 13:43:27 2009 +0200 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 2006 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -23,7 +23,7 @@ copyright " COPYRIGHT (c) 2006 by eXept Software AG - All Rights Reserved + All Rights Reserved This software is furnished under a license and may be used only in accordance with the terms of that license and with the @@ -45,20 +45,20 @@ excludedFromPreRequisites ^ #( - #'stx:libhtml' "HTMLDocumentView - referenced by UIPainter>>doOpenWidgetDocumentation " + #'stx:libhtml' "HTMLDocumentView - referenced by UIPainter>>doOpenWidgetDocumentation " ) ! preRequisites ^ #( - #'stx:libbasic' "Object - superclass of UIPainter::TreeView " - #'stx:libbasic2' "List - referenced by DataSetBuilder>>updateColumnView " - #'stx:libtool' "SystemBrowser - referenced by ResourceSelectionBrowser::ResourceMethod>>iconOn: " - #'stx:libui' "SpecCollection - referenced by UIPainterView>>fullSpecFor: " - #'stx:libview' "SimpleView - superclass of UIObjectView " - #'stx:libview2' "Model - superclass of UILayoutTool::Point " - #'stx:libwidg' "ObjectView - superclass of UIPainterView " - #'stx:libwidg2' "HierarchicalItem - superclass of MenuEditor::Item " + #'stx:libbasic' "Object - superclass of UIPainter::TreeView " + #'stx:libbasic2' "List - referenced by DataSetBuilder>>updateColumnView " + #'stx:libtool' "SystemBrowser - referenced by ResourceSelectionBrowser::ResourceMethod>>iconOn: " + #'stx:libui' "SpecCollection - referenced by UIPainterView>>fullSpecFor: " + #'stx:libview' "SimpleView - superclass of UIObjectView " + #'stx:libview2' "Model - superclass of UILayoutTool::Point " + #'stx:libwidg' "ObjectView - superclass of UIPainterView " + #'stx:libwidg2' "HierarchicalItem - superclass of MenuEditor::Item " ) ! ! @@ -78,46 +78,46 @@ classNamesAndAttributes ^ #( - " or ( attributes...) in load order" - ColorEditDialog - DataSetBuilder - (DirectoryView autoload) - (HierarchicalListEditor autoload) - ImageEditor - MenuEditor - (MethodFinderWindow autoload) - (MethodSelectionBrowser autoload) - (#'NewInspector::NewInspectorList' autoload) - (#'NewInspector::NewInspectorListView' autoload) - (#'NewInspector::NewInspectorPanelView' autoload) - (#'NewInspector::NewInspectorView' autoload) - (ProjectBrowser autoload) - (STXInstaller autoload) - SelectionBrowser - (ShellView autoload) - (SnapShotImage autoload) - (SnapShotImageMemory autoload) - TabListEditor - (#'Tools::InternationalLanguageTranslationEditor' autoload) - (#'Tools::ProjectDefinitionEditor' autoload) - UIGalleryView - UIHelpTool - UILayoutTool - UIObjectView - UIPainter - UISelectionPanel - UISpecificationTool - #'stx_libtool2' - FileSelectionBrowser - ResourceSelectionBrowser - UIPainterView - (#'Tools::ViewTreeModel' autoload) - (#'Tools::ViewTreeApplication' autoload) - (#'Tools::ViewTreeItem' autoload) - (#'Tools::ObjectModuleInformation' autoload) - FlyByWindowInformation - UIListEditor - ProjectBuilder + " or ( attributes...) in load order" + ColorEditDialog + DataSetBuilder + (DirectoryView autoload) + (HierarchicalListEditor autoload) + ImageEditor + MenuEditor + (MethodFinderWindow autoload) + (MethodSelectionBrowser autoload) + (#'Tools::NewInspectorList' autoload) + (#'Tools::NewInspectorListView' autoload) + (#'Tools::NewInspectorPanelView' autoload) + (#'Tools::NewInspectorView' autoload) + (ProjectBrowser autoload) + (STXInstaller autoload) + SelectionBrowser + (ShellView autoload) + (SnapShotImage autoload) + (SnapShotImageMemory autoload) + TabListEditor + (#'Tools::InternationalLanguageTranslationEditor' autoload) + (#'Tools::ProjectDefinitionEditor' autoload) + UIGalleryView + UIHelpTool + UILayoutTool + UIObjectView + UIPainter + UISelectionPanel + UISpecificationTool + #'stx_libtool2' + FileSelectionBrowser + ResourceSelectionBrowser + UIPainterView + (#'Tools::ViewTreeModel' autoload) + (#'Tools::ViewTreeApplication' autoload) + (#'Tools::ViewTreeItem' autoload) + (#'Tools::ObjectModuleInformation' autoload) + FlyByWindowInformation + UIListEditor + ProjectBuilder ) !