added: #hasZipFileSelectedHolder
changed:
#hasZipFileSelected
#toolsMenuSpec
"
COPYRIGHT (c) 1989 by Claus Gittinger
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
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libtool' }"
SimpleView subclass:#InspectorView
instanceVariableNames:'listView labelView workspace inspectedObject selectedLine nShown
hasMore monitorProcess hideReceiver integerDisplayRadix
inspectHistory allowFollow isStandaloneInspector selectionIndex
object inspectedObjectHolder displayStringMessage
suppressPseudoSlots dereferenceValueHolders suppressHeadline
headLineLabel'
classVariableNames:'DefaultIcon IdDictionary NextSequentialID LastExtent'
poolDictionaries:''
category:'Interface-Inspector'
!
!InspectorView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
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
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
This class implements a graphical inspector.
Inspecting can be done on an object -
(where its instvarnames/values are inspected)
or a list of objects (where a nameArray/valuesArray is inspected).
The later is used by the debugger to inspect method variables/args.
The system calls the inspector through the global variable 'Inspector'
which is bound to this class (but could be redefined - it actually is
set to MiniInspector in a smalltalk without graphical user interface,
or to NewInspector if that is wanted).
Also notice, that there are two methods to inspect an object:
sending #basicInspect to any object, will open this kind of inspector on
it (showing instance variables which are physically present).
Sending it #inspect, will - depending on the object - sometimes invoke a
specialized inspector.
(see OrderedCollectionInspectorView, ImageInspectorView,
ColorInspectorView etc. as examples).
You can also open a monitoring inspector, which displays some instance
variable in regular intervals. See #openOn:monitor:.
examples:
#(1 2 3 4) asOrderedCollection inspect
#(1 2 3 4) asOrderedCollection basicInspect
(Array new:10000) inspect
(Image fromFile:'bitmaps/claus.gif') inspect
(Image fromFile:'bitmaps/claus.gif') basicInspect
(Image fromFile:'bitmaps/SBrowser.xbm') inspect
(Image fromFile:'bitmaps/SBrowser.xbm') basicInspect
InspectorView openOn:Display
InspectorView openOn:Display monitor:'shiftDown'
The InspectorView can also be used as a subComponent within another view.
In this case, the isStandAlone flag should be cleared, to prevent the
inspector from changing the topViews window label.
Notice:
the instvars 'inspectedObject' and 'selectedLine' have been
renamed to 'object' and 'selectionIndex' for squeak compatibility;
however, the old vars are kept (in sync) for a while, to allow for
smooth migration.
Controlling the contents from the inspected object.
By redefining inspectorExtraAttributes or inspectorExtraNamedFields, the inspected
object can add items to the list of fields as ashown in the left list-view of the inspector.
These methods are meant to return a sequencable Collection of Associations, which represent
of pseudo slot-name, slot-value pairs.
In the list, extra attributes are shown with a dash (-), extra named fields are marked with a tick (`).
These are added (read only) to the list.
[author:]
Claus Gittinger
"
! !
!InspectorView class methodsFor:'instance creation'!
for:anObject
"create and launch a new inspector for anObject.
This protocol is a historic leftover - this method will vanish."
^ self openOn:anObject
!
inspect:anObject
"create and launch a new inspector for anObject.
This protocol is a historic leftover - this method will vanish."
^ self openOn:anObject
!
openOn:anObject
"create and launch a new inspector for anObject"
^ self openOn:anObject monitor:nil
"
InspectorView openOn:(5 @ 7)
InspectorView openOn:(Array new:400)
DictionaryInspectorView openOn:(IdentityDictionary new)
"
"Modified: 1.3.1996 / 19:31:03 / cg"
!
openOn:anObject monitor:anInstVarNameOrNil
"create and launch a new inspector for anObject.
If anInstVarNameOrNil is nonNil, let the inspector monitor it
(use an integer-printString as name, for indexed instVars)."
|topView inspectorView|
topView := StandardSystemView new.
topView
icon:self defaultIcon;
label:'Inspector';
iconLabel:'Inspector';
extent:self defaultTopViewExtent;
objectAttributeAt:#rememberExtent put:true.
inspectorView := self origin:(0.0 @ 0.0)
corner:(1.0 @ 1.0)
in:topView.
"kludge: must realize first, to be able to set menu again"
topView openAndWait.
topView windowGroup
focusSequence:(Array
with:inspectorView listView
with:inspectorView workspace).
inspectorView
allowFollow:true;
isStandaloneInspector:true;
inspect:anObject.
anInstVarNameOrNil notNil ifTrue:[
inspectorView monitor:anInstVarNameOrNil
].
^ inspectorView
"
|m|
m := 1 asValue.
InspectorView openOn:m monitor:'value'.
2 to:10 do:[:i |
Delay waitForSeconds:1.
m value:i
]
"
"
|o|
o := Array with:1 with:2 with:3.
InspectorView openOn:o monitor:'2'.
Delay waitForSeconds:1.
o at:2 put:20
"
"Created: / 01-03-1996 / 19:30:50 / cg"
"Modified: / 23-10-2007 / 19:08:21 / cg"
!
openOn:anObject withEvalPane:withEvalPane
^ self openOn:anObject
!
openOn:anObject withEvalPane:withEvalPane withLabel:aLabel
^ self openOn:anObject
! !
!InspectorView class methodsFor:'defaults'!
defaultExtent
^ (Screen current usableExtent // 3)
"Created: / 7.9.1998 / 13:47:45 / cg"
"Modified: / 7.9.1998 / 14:15:38 / cg"
!
defaultIcon
"return the browsers default window icon"
<resource: #programImage>
<resource: #style (#INSPECTOR_ICON #INSPECTOR_ICON_FILE)>
|nm i resources|
(i := DefaultIcon) isNil ifTrue:[
resources := self classResources.
i := resources at:#INSPECTOR_ICON default:nil.
i isNil ifTrue:[
nm := resources at:#INSPECTOR_ICON_FILE default:'Inspector.xbm'.
i := Smalltalk imageFromFileNamed:nm forClass:self.
i isNil ifTrue:[
i := StandardSystemView defaultIcon
]
].
i notNil ifTrue:[
DefaultIcon := i := i onDevice:Display
]
].
^ i
"
DefaultIcon := nil
"
"Modified: / 17-09-2007 / 11:36:17 / cg"
!
defaultTopViewExtent
|def|
def := LastExtent ? self defaultExtent.
^ def min:(Screen current usableExtent)
"Created: / 23-10-2007 / 19:04:13 / cg"
!
rememberLastExtent:anExtent
LastExtent := anExtent
"Created: / 23-10-2007 / 19:10:02 / cg"
! !
!InspectorView class methodsFor:'queries-plugin'!
aspectSelectors
^ #( inspectedObjectHolder )
"Modified: / 10.2.2000 / 12:25:28 / cg"
! !
!InspectorView methodsFor:'accessing'!
allowFollow:aBoolean
"enable/disable the follow menu item;
This is disabled for inspectors which are embedded in the debugger"
allowFollow := aBoolean
!
dereferenceValueHolders:aBoolean
dereferenceValueHolders := aBoolean
!
fieldListLabel:aString
labelView label:aString
"Created: 28.6.1996 / 15:30:26 / cg"
!
headLineLabel:aString
"an alternative headline label (if used as embedded inspector)"
headLineLabel := aString.
labelView notNil ifTrue:[
labelView label:headLineLabel.
].
"Modified: / 25-11-2010 / 17:16:45 / cg"
!
headLineLabelView
"provides access to the headline"
^ labelView
"Created: / 21-01-2011 / 12:07:13 / cg"
!
hideReceiver:aBoolean
"hide/show the self-entry for the inspected object;
This is hidden for context inspectors in the debugger"
hideReceiver := aBoolean
"Created: 28.6.1996 / 15:08:32 / cg"
!
inspect:anObject
"set/update the object to be inspected"
|aList sameObject sameClass oldSelectedField idx|
"/ (anObject isNil and:[object isNil]) ifTrue:[^ self].
sameObject := (anObject == object) and:[object notNil].
sameClass := (anObject class == object class).
selectionIndex notNil ifTrue:[
oldSelectedField := (listView list ? #()) at:selectionIndex ifAbsent:nil.
].
inspectedObject := object := anObject.
((sameObject | sameClass) and:[listView list notEmptyOrNil]) ifTrue:[
"/ listView setContents:aList.
] ifFalse:[
hasMore := false.
aList := self fieldList.
hasMore ifTrue:[
aList add:' ... '
].
listView contents:aList.
workspace contents:nil.
self setDoItAction.
].
sameClass ifFalse:[
selectionIndex := selectedLine := nil.
].
isStandaloneInspector ifTrue:[
"/ not embedded (as in the debugger)
self topView
label:(self labelFor:anObject);
iconLabel:(self labelNameFor:anObject).
].
(sameObject | sameClass) ifFalse:[
idx := (listView list ? #()) indexOf:oldSelectedField.
idx ~~ 0 ifTrue:[
listView selection:idx
] ifFalse:[
self setInitialSelection.
]
].
self showSelection:(selectedLine ? 1).
"Modified: / 19-01-2011 / 14:24:36 / cg"
!
isStandaloneInspector:aBoolean
"obsolete now"
isStandaloneInspector := aBoolean
"Modified: / 12.2.1999 / 16:01:44 / cg"
!
label:aString
"set the fieldListLabel - obsolete; collides with inherited label-functionality"
<resource:#obsolete>
self obsoleteMethodWarning:'use fieldListLabel:'.
self fieldListLabel:aString.
super label:aString.
"Created: 28.6.1996 / 15:30:26 / cg"
!
listView
^ listView
!
reinspect
"update display for a changed inspectedObject"
|aList|
hasMore := false.
aList := self fieldList.
hasMore ifTrue:[
aList add:' ... '
].
listView contents:aList.
"/ workspace contents:nil.
self setDoItAction.
selectionIndex := selectedLine := nil
!
suppressHeadline:aBoolean
"hide/show the title line above the list/value"
suppressHeadline := aBoolean.
labelView notNil ifTrue:[
suppressHeadline == true ifTrue:[
labelView beInvisible.
listView container topInset:0.
workspace container topInset:0.
] ifFalse:[
labelView beVisible.
listView container topInset:(labelView preferredHeight).
workspace container topInset:(labelView preferredHeight).
].
].
"Created: / 09-11-2010 / 14:50:04 / cg"
"Modified: / 05-02-2011 / 14:03:55 / cg"
!
suppressPseudoSlots:aBoolean
suppressPseudoSlots := aBoolean
!
workspace
^ workspace
! !
!InspectorView methodsFor:'accessing-channels'!
inspectedObjectHolder
inspectedObjectHolder isNil ifTrue:[
inspectedObjectHolder := ValueHolder new.
inspectedObjectHolder addDependent:self.
].
^ inspectedObjectHolder
"Created: / 10.2.2000 / 13:33:16 / cg"
"Modified: / 10.2.2000 / 13:34:23 / cg"
!
inspectedObjectHolder:aValueHolder
inspectedObjectHolder notNil ifTrue:[
inspectedObjectHolder removeDependent:self.
].
inspectedObjectHolder := aValueHolder.
inspectedObjectHolder notNil ifTrue:[
inspectedObjectHolder addDependent:self.
].
"Created: / 10.2.2000 / 13:34:53 / cg"
! !
!InspectorView methodsFor:'change & update'!
update:something with:aParameter from:changedObject
"Invoked when one of my dependees sends a change notification."
|oldSelection|
changedObject == object ifTrue:[
oldSelection := listView selection.
self inspect:object.
oldSelection notNil ifTrue:[
self showSelection:oldSelection
]
].
changedObject == object ifTrue:[
self inspect:(object value)
].
super update:something with:aParameter from:changedObject
"Created: / 10.2.2000 / 13:46:38 / cg"
"Modified: / 10.2.2000 / 13:48:18 / cg"
! !
!InspectorView methodsFor:'drag & drop'!
getDisplayObjects
^List with:self selection printString
"Created: / 16-08-2005 / 21:54:52 / janfrog"
"Modified: / 18-09-2006 / 21:11:16 / cg"
!
getDropObjects
^List with:(DropObject new:self selection).
"Created: / 16-08-2005 / 21:49:23 / janfrog"
"Modified: / 18-09-2006 / 21:11:31 / cg"
! !
!InspectorView methodsFor:'event handling'!
keyPress:key x:x y:y
"handle special keys"
<resource: #keyboard (#BrowseIt #InspectIt)>
self selection notNil ifTrue:[
(key == #BrowseIt) ifTrue:[
self browse.
^ self.
].
(key == #InspectIt) ifTrue:[
self doInspect.
^ self.
].
].
"all my other input is passed on to the workspace-field"
x notNil ifTrue:[
"/ not already delegated
workspace keyPress:key x:-1 y:-1
].
!
sizeChanged:how
super sizeChanged:how.
isStandaloneInspector == true ifTrue:[
LastExtent := self topView extent.
].
! !
!InspectorView methodsFor:'initialization & release'!
destroy
(self topView objectAttributeAt:#rememberExtent) == true ifTrue:[
self class rememberLastExtent:(self topView extent).
].
inspectedObject := object := nil.
monitorProcess notNil ifTrue:[
monitorProcess terminate
].
super destroy
"Modified: / 23-10-2007 / 19:11:04 / cg"
!
initialize
|v panel helpView labelView2|
super initialize.
displayStringMessage := #displayString.
hideReceiver := false.
integerDisplayRadix := 10.
allowFollow := false.
isStandaloneInspector := false.
panel := VariableHorizontalPanel
origin:(0.0 @ 0.0)
corner:(1.0 @ 1.0)
in:self.
helpView := View origin:(0.0 @ 0.0) corner:(0.3 @ 1.0) in:panel.
helpView level:0; borderWidth:0.
suppressHeadline == true ifFalse:[
labelView := Label origin:0.0@0.0 corner:1.0@0.0 in:helpView.
labelView label:(headLineLabel ? self defaultLabel).
labelView bottomInset:(labelView preferredHeight negated).
].
v := HVScrollableView
for:SelectionInListView
miniScrollerH:true
miniScrollerV:false
in:helpView.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
labelView notNil ifTrue:[
v topInset:(labelView preferredHeight).
].
"/ v autoHideScrollBars:true.
listView := v scrolledView.
listView action:[:lineNr | self selection:lineNr.].
listView doubleClickAction:[:lineNr | self doInspect].
listView ignoreReselect:false.
listView menuHolder:self; menuPerformer:self; menuMessage:#fieldMenu.
self initializeDragAndDrop.
helpView := View origin:(0.3 @ 0.0) corner:(1.0 @ 1.0) in:panel.
helpView level:0; borderWidth:0.
suppressHeadline == true ifFalse:[
labelView2 := Label origin:0.0@0.0 corner:1.0@0.0 in:helpView.
labelView2 label:''.
labelView2 bottomInset:(labelView preferredHeight negated).
].
v := HVScrollableView
for:CodeView
miniScrollerH:true
miniScrollerV:false
in:helpView.
"/ v autoHideScrollBars:true.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
labelView2 notNil ifTrue:[
v topInset:(labelView2 preferredHeight).
].
workspace := v scrolledView.
self setAcceptAction.
nShown := 100.
hasMore := false.
"Modified: / 16-08-2005 / 21:54:04 / janfrog"
"Modified: / 11-11-2010 / 17:13:46 / cg"
!
initializeDragAndDrop
| source |
source := DropSource
receiver:self
argument:nil
dropObjectSelector:#getDropObjects
displayObjectSelector:#getDisplayObjects
dropFeedBackSelector:nil.
listView dropSource:source.
"Created: / 16-08-2005 / 21:51:43 / janfrog"
"Modified: / 18-09-2006 / 21:13:05 / cg"
!
realize
"delayed setup of lists till first map-time -
this makes startup of inspectors a bit faster"
|o|
super realize.
"/ cg: I dont remember what this was needed for (is it still?)
false "object notNil" ifTrue:[
"
kludge to trick inspect:, which ignores setting the
same object again ...
"
o := object.
inspectedObject := object := nil.
self inspect:o
]
"Created: / 30-05-1996 / 09:38:37 / cg"
"Modified: / 05-11-2007 / 20:11:44 / cg"
!
release
"release inpected object. This is normally not needed,
since the garbage collector will find this memory alone.
However, if some applications keeps invisible inspectors around
(for example, the debugger does this), the inspected object
would be kept from being freed or freed very late."
"
inspectedObject notNil ifTrue:[
inspectedObject removeDependent:self
].
"
inspectedObject := object := nil.
self setDoItAction. "/ to release ref to inspectedObject in doItBlock
workspace contents:nil.
listView contents:nil.
super release.
"Modified: 11.6.1997 / 13:20:39 / cg"
!
setInitialSelection
object isLazyValue ifFalse:[
object isString ifTrue:[
self showSelection:1 "/ the self-line
]
].
! !
!InspectorView methodsFor:'menu'!
fieldMenu
"return the menu for the field-list"
<resource: #programMenu>
|items m sel protocolMenu localProtocolMenu
protocols protocolsSorted
selectorsByFirstCharacter alphaMenu
localSelectors|
items := #(
('Copy Name or Key' #doCopyKey )
('-')
('Inspect' #doInspect )
('BasicInspect' #doBasicInspect )
).
NewInspector::NewInspectorView notNil ifTrue:[
items := items , #(
('Inspect Hierarchical' #doNewInspect )
).
].
items := items , #(
('Browse' #browse )
).
items := items , (self optionalToolItems).
items := items , (self optionalViewSelectionItems).
items := items , #(
('-')
('Owners' #showOwners )
('Ref Chains' #showReferences )
"/ ('Browse class hierarchy' #browseClassHierarchy )
"/ ('Browse full class protocol' #browseFullClassProtocol)
).
sel := self selection.
items := items , (self optionalMethodOrBlockSelectionItems).
items := items , (self optionalStreamSelectionItems).
items := items , (self optionalFilenameSelectionItems).
items := items , (self optionalByteArraySelectionItems).
items := items , #(
('-')
('Local Protocol' #localProtocolMenu )
('Full Protocol' #protocolMenu )
('-')
('Trap Message...' #doTrap )
('Trap all Messages' #doTrapAll )
('Trace all Messages' #doTraceAll )
('Untrace/Untrap' #doUntrace )
"/ ('-')
"/ ('Trap change to instVar' #doTrapInstVarChange )
"/ ('Trap change to any instVar' #doTrapAnyInstVarChange )
).
allowFollow ifTrue:[
items := #(
('Follow' #doFollow )
('Back' #doBack )
('-')
)
,
items.
].
monitorProcess isNil ifTrue:[
items := items , #(
('Start Monitor' #doStartMonitor )
).
] ifFalse:[
items := items , #(
('Stop Monitor' #doStopMonitor )
).
].
hasMore ifTrue:[
items := items , #(
('-')
('Show More' #showMore )
)
].
protocols := Dictionary new.
selectorsByFirstCharacter := Dictionary new.
object class withAllSuperclassesDo:[:eachClass |
eachClass methodDictionary keysAndValuesDo:[:sel :m |
sel numArgs == 0 ifTrue:[
(protocols at:m category ifAbsentPut:[Set new]) add:sel.
(selectorsByFirstCharacter at:(sel first asString) ifAbsentPut:[Set new]) add:sel.
]
].
].
protocolsSorted := protocols keys asArray sort.
protocolMenu := PopUpMenu
labels:#('alphabetical' '=') , protocolsSorted
selectors:#(nil nil) , protocolsSorted.
protocolMenu
subMenuAt:'alphabetical'
put:[
|firstChars|
firstChars := selectorsByFirstCharacter keys asOrderedCollection sort.
alphaMenu := PopUpMenu
labels:firstChars
selector:#mmm
args:firstChars
receiver:self.
firstChars do:[:ch |
alphaMenu
subMenuAt:ch
put:[
|selectors sortedSelectors|
selectors := selectorsByFirstCharacter at:ch.
sortedSelectors := selectors asArray sort.
protocolMenu := PopUpMenu
labels:sortedSelectors
selector:#letSelectedObjectPerform:
args:sortedSelectors
receiver:self.
]
].
alphaMenu
].
protocolsSorted do:[:p |
protocolMenu
subMenuAt:p
put:[
|selectors sortedSelectors|
selectors := protocols at:p.
sortedSelectors := selectors asArray sort.
protocolMenu := PopUpMenu
labels:sortedSelectors
selector:#letSelectedObjectPerform:
args:sortedSelectors
receiver:self.
]
].
localSelectors := object class methodDictionary keys asArray sort.
localProtocolMenu := PopUpMenu
labels:localSelectors
selector:#letSelectedObjectPerform:
args:localSelectors
receiver:self.
items := items , (self numberBaseItems).
m := PopUpMenu
itemList:items
resources:resources.
m subMenuAt:#protocolMenu put:protocolMenu.
m subMenuAt:#localProtocolMenu put:localProtocolMenu.
(self theSingleSelectionIndex isNil) ifTrue:[
m disableAll:#(doFollow doInspect doBasicInspect doNewInspect
browse browseClassHierarchy browseFullClassProtocol
doStartMonitor doCopyKey doCopyKey)
].
(self hasSelfEntry and:[selectionIndex == 1]) ifTrue:[
m disableAll:#(doFollow doCopyKey "doInspect doBasicInspect")
].
inspectHistory size == 0 ifTrue:[
m disable:#doBack
].
sel class hasImmediateInstances ifTrue:[
m disableAll:#(showReferences doNewInspect)
].
"/ sel inspectorClass == self class ifFalse:[
"/ m disable:#doFollow
"/ ].
sel isMethod ifFalse:[
m disable:#browseMethodsClass
].
^ m
"Modified: / 27-01-2011 / 12:08:54 / cg"
!
numberBaseItems
^ {
#('-') .
(integerDisplayRadix == 10)
ifFalse:[ #('Decimal Integers' #setDisplayRadixTo10 ) ] .
(integerDisplayRadix == 2)
ifFalse:[ #('Binary Integers' #setDisplayRadixTo2 ) ] .
(integerDisplayRadix == 16)
ifFalse:[ #('Hex Integers' #setDisplayRadixTo16 ) ] .
} select:[:el | el notNil].
"Modified: / 24-08-2010 / 17:31:51 / cg"
!
optionalByteArraySelectionItems
|sel|
sel := self selection.
(object isByteArray) ifTrue:[
^ #(
('Save Bytes to File...' #saveBytesToFile)
).
].
^ #()
"Created: / 25-01-2011 / 17:16:12 / cg"
!
optionalFilenameSelectionItems
|sel|
sel := self selection.
(object isFilename or:[sel isFilename]) ifTrue:[
OperatingSystem isMSWINDOWSlike ifTrue:[
^ #(
('Show in Explorer' #showInWindowsExplorer)
('Open FileBrowser' #openFileBrowser)
).
].
^ #(
('Open FileBrowser' #openFileBrowser)
).
].
^ #()
"Created: / 09-02-2007 / 16:10:30 / cg"
"Modified: / 05-02-2011 / 15:49:48 / cg"
!
optionalMethodOrBlockSelectionItems
|sel items|
sel := self selection.
items := #().
(sel isBlock or:[sel isContext]) ifTrue:[
items := items , #(
('Browse Blocks Home' #browseHome)
).
].
(object isMethod or:[sel isMethod]) ifTrue:[
items := items , #(
('Browse Methods Class' #browseMethodsClass)
).
].
(selectionIndex notNil
and:[(self fieldList at:selectionIndex ifAbsent:nil) = '-dependents']) ifTrue:[
items := items , #(
('Browse Update Methods' #browseUpdateMethods)
).
].
^ items
!
optionalStreamSelectionItems
|sel|
sel := self selection.
sel isStream ifTrue:[
sel isFileStream ifTrue:[
OperatingSystem isMSWINDOWSlike ifTrue:[
^ #(
('Show in Explorer' #showInWindowsExplorer)
('Open FileBrowser' #openFileBrowser)
).
].
^ #(
('Open FileBrowser' #openFileBrowser)
).
].
sel isExternalStream ifFalse:[
^ #(
('Show Stream Contents' #showStreamContents)
).
].
].
^ #()
"Created: / 09-02-2007 / 16:09:15 / cg"
"Modified: / 05-02-2011 / 15:49:55 / cg"
!
optionalToolItems
"inserted after inspect/browse"
^ #()
"Created: / 27-01-2011 / 11:51:12 / cg"
!
optionalViewSelectionItems
|sel|
sel := self selection.
sel isView ifTrue:[
^ #(
('Show Widget Hierarchy' #openWidgetHierarchy)
).
].
^ #()
! !
!InspectorView methodsFor:'menu actions'!
browse
|cls|
cls := (self selection ? object) class.
(cls browserClass ? UserPreferences current systemBrowserClass) openInClass:cls selector:nil
"Created: / 14.12.1995 / 19:15:50 / cg"
"Modified: / 14.10.1998 / 15:32:10 / cg"
!
browseClass
|cls|
cls := (self selection ? object) class.
cls browserClass browseClass:cls
"Modified: 3.5.1996 / 12:39:32 / cg"
!
browseClassHierarchy
|cls|
cls := (self selection ? object) class.
cls browserClass browseClassHierarchy:cls
"Modified: 3.5.1996 / 12:40:04 / cg"
!
browseFullClassProtocol
|cls|
cls := (self selection ? object) class.
cls browserClass browseFullClassProtocol:cls
"Modified: 3.5.1996 / 12:40:17 / cg"
!
browseHome
|sel mthd|
sel := self selection ? object.
sel isBlock ifTrue:[
mthd := sel homeMethod
] ifFalse:[
sel isContext ifTrue:[
mthd := sel method.
]
].
mthd isNil ifTrue:[
^ self warn:'Sorry - cannot figure out home method.'
].
mthd class browserClass
openInClass:mthd mclass selector:mthd selector
!
browseMethodsClass
|mthd|
mthd := self selection.
mthd mclass browserClass
openInClass:mthd mclass selector:mthd selector
!
browseUpdateMethods
|deps methods|
deps := self selection.
methods := Set new.
deps do:[:each |
|implClass|
implClass := each class whichClassIncludesSelector:#'update:with:from:'.
implClass notNil ifTrue:[
methods add:(implClass compiledMethodAt:#'update:with:from:')
]
].
methods isEmpty ifTrue:[^ self].
methods first mclass browserClass
browseMethods:methods
title:'Update Method(s) of dependent(s)'
!
doBack
"user selected back-menu entry"
|objectToInspect|
inspectHistory size > 0 ifTrue:[
objectToInspect := inspectHistory removeLast.
inspectHistory size == 0 ifTrue:[
inspectHistory := nil
].
self inspect:objectToInspect.
]
"Created: / 22.9.1998 / 18:22:01 / cg"
"Modified: / 22.9.1998 / 18:22:28 / cg"
!
doBasicInspect
"user selected inspect-menu entry"
self doInspect:true
!
doFollow
"user selected follow-menu entry"
|objectToInspect|
selectionIndex notNil ifTrue:[
objectToInspect := self selection.
inspectHistory isNil ifTrue:[
inspectHistory := OrderedCollection new
].
inspectHistory addLast:object.
self inspect:objectToInspect.
]
"Created: / 22.9.1998 / 18:21:08 / cg"
"Modified: / 22.9.1998 / 18:22:23 / cg"
!
doInspect
"user selected inspect-menu entry"
self doInspect:false
!
doNewInspect
self doInspect:#new
"Created: / 31.10.1997 / 12:45:38 / cg"
"Modified: / 31.10.1997 / 12:47:11 / cg"
!
doStartMonitor
"start a monitoring process"
monitorProcess isNil ifTrue:[
monitorProcess :=
[
|sel|
[true] whileTrue:[
(sel := selectionIndex) notNil ifTrue:[
self showSelection:sel
].
(Delay forSeconds:0.5) wait
]
] forkAt:Processor userBackgroundPriority
]
"Modified: 12.4.1996 / 14:20:06 / cg"
!
doStopMonitor
"stop the monitor"
monitorProcess terminate.
monitorProcess := nil
!
doTraceAll
"place a trace on all messages sent to the inspected object"
self topView withWaitCursorDo:[MessageTracer traceAll:object on:Transcript]
!
doTrap
"place a trap on a message sent to the inspected object"
|string selector|
string := Dialog request:'Selector to trap on:' onCancel:nil.
string notNil ifTrue:[
selector := string asSymbolIfInterned.
selector isNil ifTrue:[
self warn:'no such selector'
] ifFalse:[
self topView withWaitCursorDo:[MessageTracer trap:object
selector:selector]
]
]
"Modified: 12.4.1996 / 14:07:01 / cg"
!
doTrapAll
"place a trap on all messages sent to the inspected object"
self topView withWaitCursorDo:[MessageTracer trapAll:object]
!
doTrapAnyInstVarChange
"place a trap which is triggered if any instVar of the inspected object is changed"
self topView withWaitCursorDo:[
MessageTracer trapModificationsIn:object
]
!
doTrapInstVarChange
"place a trap which is triggered if the selected instVar of the inspected object is changed"
self topView withWaitCursorDo:[
|idx|
"/ a named instVar ?
idx := self instVarIndexForLine:selectionIndex.
idx isNil ifTrue:[
self warn:'select an instance variable first.'.
^ self.
].
MessageTracer
trapModificationsOf:(object class allInstVarNames at:idx)
in:object
]
!
doUntrace
"remove traps/traces"
MessageTracer untrace:object
!
inspectOwners
"open an inspector on owners of the inspectedObject.
(this is a secret function)"
self withCursor:(Cursor questionMark) do:[
|owners dict|
owners := (ObjectMemory whoReferences:object) asOrderedCollection.
owners size > 500 ifTrue:[
(self confirm:'there are ' , owners size printString , ' owners.\\Do you really want to see them all ?' withCRs)
ifFalse:[^ self]
].
dict := IdentityDictionary new.
owners do:[:owner |
|set names oClass|
owner ~~ self ifTrue:[
set := Set new.
names := owner class allInstVarNames.
oClass := owner class.
1 to:oClass instSize do:[:i |
(owner instVarAt:i) == object ifTrue:[
set add:(names at:i).
].
].
oClass isVariable ifTrue:[
oClass isPointers ifTrue:[
1 to:owner basicSize do:[:i |
(owner basicAt:i) == object ifTrue:[
set add:i
]
]
]
].
dict at:owner put:set
].
].
dict inspect
]
!
letSelectedObjectPerform:aSelector
|sel argString|
sel := self selection ? object.
aSelector numArgs == 0 ifTrue:[
(sel perform:aSelector) inspect.
^ self.
].
aSelector numArgs == 1 ifTrue:[
argString := Dialog request:'Argument (Smalltalk Object)'.
argString isEmptyOrNil ifTrue:[^ self].
(sel perform:aSelector with:(Object readFrom:argString)) inspect.
^ self.
].
self halt.
"Modified: / 07-10-2010 / 14:34:21 / cg"
!
openFileBrowser
|fn|
fn := self selection.
fn isNil ifTrue:[ fn := inspectedObject ].
fn isStream ifTrue:[
fn := fn pathName asFilename
].
(UserPreferences current fileBrowserClass) openOnFileNamed:fn.
"Modified: / 28-10-2010 / 12:49:50 / cg"
!
openWidgetHierarchy
|view|
view := self selection.
view isView ifFalse:[^ self].
WindowTreeView openOn:view
!
saveBytesToFile
|fn|
fn := Dialog requestFileName:'Save bytes into:'.
fn isEmptyOrNil ifTrue:[^ self].
fn asFilename contents:inspectedObject.
"Modified: / 25-01-2011 / 17:23:38 / cg"
!
showInWindowsExplorer
"show in explorer"
|fn dir|
fn := self selection.
fn isNil ifTrue:[ fn := inspectedObject ].
fn isStream ifTrue:[
fn := fn pathName asFilename
].
dir := fn isDirectory
ifTrue:[ fn ]
ifFalse:[ fn directory ].
OperatingSystem
openApplicationForDocument:dir
operation:#explore.
"Created: / 05-02-2011 / 15:49:33 / cg"
!
showOwners
|o|
o := self selection.
self withCursor:(Cursor questionMark) do:[
|owners dict|
owners := (ObjectMemory whoReferences:o).
owners isEmptyOrNil ifTrue:[
self information:'No owners found.'.
^ self
].
owners := owners asOrderedCollection.
"
skip weakArrays ... (they dont count)
"
owners := owners reject:[:owner | owner isMemberOf:WeakArray].
owners inspect.
"/ inspector := DictionaryInspectorView openOn:dict.
"/ inspector listView doubleClickAction:[:lineNr | inspector doInspectKey].
]
"Modified: 15.10.1996 / 22:09:38 / cg"
!
showReferences
"user selected references-menu entry"
self selection class hasImmediateInstances ifTrue:[
^ self warn:'Sorry - cannot show references to immediate objects'
].
ObjectMemory displayRefChainTo:(self selection)
"Modified: / 30.7.1998 / 14:03:16 / cg"
!
showStreamContents
|sel|
sel := self selection.
(sel isStream and:[sel isExternalStream not]) ifTrue:[
workspace replace:(sel contents printString)
].
"Created: / 6.2.2000 / 13:46:37 / cg"
"Modified: / 6.2.2000 / 13:47:37 / cg"
! !
!InspectorView methodsFor:'private'!
baseInspectedObjectClass
^ Object
!
defaultLabel
^ 'InstVars & Pseudo Slots'
"Modified: / 05-02-2011 / 14:06:26 / cg"
!
derivedFieldNames
|d actionItems valueItems otherItems|
d := self derivedFields.
(d isKindOf:Dictionary) ifTrue:[
actionItems := d keys select:[:k | k startsWith:'!!'] as:OrderedCollection .
valueItems := d keys select:[:k | k startsWith:'-'] as:OrderedCollection.
otherItems := d keys select:[:k | (k startsWithAnyOf:#('!!' '-')) not] as:OrderedCollection.
^ ((actionItems sort , valueItems sort) collect:[:k | (k copyTo:1),(k copyFrom:2) allItalic])
,
otherItems sort
].
^ d collect:[:eachEntry |
|nm|
nm := (eachEntry isAssociation)
ifTrue:[ eachEntry key ]
ifFalse:[ eachEntry first ].
'-',nm allItalic
]
"Created: / 03-08-2006 / 15:02:54 / cg"
"Modified: / 27-01-2011 / 11:45:17 / cg"
!
derivedFields
"the check below is not sufficient - if someone catches messages, for example.
Therefore, we do a manual lookup here:"
(object class whichClassIncludesSelector:#inspectorExtraAttributes) isNil ifTrue:[
^ #()
].
^ [object inspectorExtraAttributes]
on: MessageNotUnderstood
do: [:ex | ex return: #() ]
"Created: / 17-07-2006 / 11:02:32 / cg"
"Modified: / 29-08-2006 / 13:03:31 / cg"
!
extraNamedFieldNames
^ self extraNamedFields
collect:[:eachEntry |
|nm|
nm := (eachEntry isAssociation)
ifTrue:[ eachEntry key ]
ifFalse:[ eachEntry first ].
'`',nm
]
"Modified: / 03-08-2006 / 15:17:19 / cg"
!
extraNamedFields
"by redefining inspectorExtraNamedFields to return an array of
pseudo-fieldName->value associations, the inspectors left list can be extended"
"the check below is not sufficient - if someone catches messages, for example.
Therefore, we do a manual lookup here:"
(object class whichClassIncludesSelector:#inspectorExtraNamedFields) isNil ifTrue:[
^ #()
].
^ [object inspectorExtraNamedFields]
on: MessageNotUnderstood
do: [:ex | ex return: #() ]
"Created: / 03-08-2006 / 13:34:18 / cg"
"Modified: / 29-08-2006 / 13:03:57 / cg"
!
extraNamedVarIndexForLine:lineNr
"helper - return the index for a named instVar;
nil, if self or a keyed instvar is selected."
|idx nNamedInstvarsShown nExtraNamedInstvarsShown cls baseCls firstRealIndex line|
lineNr isNil ifTrue:[^ nil].
firstRealIndex := 1.
idx := lineNr.
self hasSelfEntry ifTrue:[
(lineNr == 1 or:[lineNr isNil]) ifTrue:[
^ nil "/ self selected
].
idx := idx - 1.
firstRealIndex := 2.
].
[line := listView at:firstRealIndex.
(line startsWith:'-') and:[line size < 2 or:[line second isDigit not]]] whileTrue:[
firstRealIndex := firstRealIndex + 1.
idx := idx - 1.
].
cls := object class.
baseCls := self baseInspectedObjectClass.
nNamedInstvarsShown := cls instSize.
"/ only the namedInstvars below baseInspectedObjectClass
"/ are shown ...
(cls == baseCls or:[cls isSubclassOf:baseCls]) ifTrue:[
nNamedInstvarsShown := nNamedInstvarsShown - baseCls instSize.
].
idx := idx - nNamedInstvarsShown.
idx < 1 ifTrue:[
^ nil.
].
nExtraNamedInstvarsShown := self extraNamedFields size.
idx <= nExtraNamedInstvarsShown ifTrue:[
^ idx.
].
^ nil "/ indexed instvar or other selected
"Created: / 03-08-2006 / 13:45:14 / cg"
"Modified: / 04-08-2006 / 11:45:29 / cg"
!
fieldList
"return a list of names to show in the selectionList.
Leave hasMore as true, if a '...' entry should be added."
|derivedFieldList namedFieldList fieldList cls indexedList extraNamedFieldList|
object isNil ifTrue:[
^ self hasSelfEntry ifFalse:[ #() ] ifTrue:[ #('-self') ]
].
cls := object class.
self topView withWaitCursorDo:[
namedFieldList := self namedFieldList.
indexedList := self indexedFieldList.
extraNamedFieldList := OrderedCollection new.
self hasSelfEntry ifTrue:[
self suppressPseudoSlots ifFalse:[
derivedFieldList := OrderedCollection new.
derivedFieldList addAll:(self pseudoFieldNamesWithIndexed:(indexedList notEmptyOrNil)).
derivedFieldList addAll:(self derivedFieldNames).
extraNamedFieldList addAll:(self extraNamedFieldNames).
].
].
fieldList := OrderedCollection new.
derivedFieldList notNil ifTrue:[fieldList addAll:derivedFieldList].
namedFieldList notNil ifTrue:[fieldList addAll:namedFieldList].
extraNamedFieldList notNil ifTrue:[fieldList addAll:extraNamedFieldList].
indexedList notNil ifTrue:[fieldList addAll:indexedList].
].
^ fieldList
"Modified: / 18-09-2006 / 21:16:03 / cg"
!
hasSelfEntry
^ hideReceiver not and:[self suppressPseudoSlots not]
"Created: 14.12.1995 / 19:30:03 / cg"
"Modified: 28.6.1996 / 15:13:41 / cg"
!
indexList
"return a list of indexes usable to access the object's indexed slots.
Set hasMore to true, if a '...' entry should be added."
|objSz n cls sz|
cls := object class.
cls isVariable ifFalse:[^ nil ].
n := objSz := object basicSize.
(n > nShown) ifTrue:[
n := nShown.
hasMore := true.
].
^ (1 to:n)
"Modified: / 24-08-2010 / 17:56:23 / cg"
!
indexOfFirstNamedInstvarInList
"helper - return the index for the first named instVar;
nil, if self or a keyed instvar is selected."
|firstRealIndex|
firstRealIndex := 1.
self hasSelfEntry ifTrue:[
firstRealIndex := 2.
].
[
|line|
line := listView at:firstRealIndex.
(line startsWith:'-') and:[line size < 2 or:[line second isDigit not]]
] whileTrue:[
firstRealIndex := firstRealIndex + 1.
].
^ firstRealIndex
!
indexedFieldList
"return a list of indexed-variable names to show in the selectionList.
Set hasMore to true, if a '...' entry should be added."
|l maxIndex sz|
l := self indexList.
l isNil ifTrue:[^ nil ].
integerDisplayRadix ~~ 10 ifTrue:[
maxIndex := l last.
maxIndex isInteger ifTrue:[
sz := (maxIndex printStringRadix:integerDisplayRadix) size.
] ifFalse:[
sz := 0
].
^ l collect:[:i |
i isInteger ifTrue:[
(i printStringRadix:integerDisplayRadix size:sz fill:$0)
] ifFalse:[
i printString
]
]
] ifFalse:[
^ l collect:[:i | i printString].
].
"Modified: / 24-08-2010 / 17:57:47 / cg"
!
indexedValueAtIndex:idx
^ object basicAt:idx
!
indexedValueAtIndex:idx put:newValue
object basicAt:idx put:newValue
!
indexedValueAtKey:key
"/ kludge
object isLimitedPrecisionReal ifTrue:[
^ object basicAt:key
].
^ object at:key
!
instVarIndexForLine:lineNr
"helper - return the index for a named instVar;
nil, if self or a keyed instvar is selected."
|idx nNamedInstvarsShown cls baseCls firstRealIndex line|
lineNr isNil ifTrue:[^ nil].
firstRealIndex := 1.
idx := lineNr.
self hasSelfEntry ifTrue:[
(lineNr == 1 or:[lineNr isNil]) ifTrue:[
^ nil "/ self selected
].
idx := idx - 1.
firstRealIndex := 2.
].
[line := listView at:firstRealIndex.
(line startsWith:'-') and:[line size < 2 or:[line second isDigit not]]] whileTrue:[
firstRealIndex := firstRealIndex + 1.
idx := idx - 1.
].
cls := object class.
baseCls := self baseInspectedObjectClass.
nNamedInstvarsShown := cls instSize.
"/ only the namedInstvars below baseInspectedObjectClass
"/ are shown ...
(cls includesBehavior:baseCls) ifTrue:[
nNamedInstvarsShown := nNamedInstvarsShown - baseCls instSize.
].
idx <= nNamedInstvarsShown ifTrue:[
^ idx + self baseInspectedObjectClass instSize.
].
^ nil "/ indexed instvar or other selected
"Modified: / 31.10.2001 / 09:20:20 / cg"
!
keyIndexForLine:lineNr
"helper - return the index of the key-list;
nil, if self or a namedInstVar is selected."
|idx nNamedInstvarsShown nExtraNamedInstvarsShown cls baseCls firstRealIndex line|
lineNr isNil ifTrue:[^ nil].
firstRealIndex := 1.
idx := lineNr.
self hasSelfEntry ifTrue:[
(lineNr == 1 or:[lineNr isNil]) ifTrue:[
^ nil "/ self selected
].
idx := idx - 1.
firstRealIndex := firstRealIndex + 1.
].
[line := listView at:firstRealIndex.
line notNil
and:[(line startsWith:'-') and:[line size < 2 or:[line second isDigit not]]]
] whileTrue:[
firstRealIndex := firstRealIndex + 1.
idx := idx - 1.
].
cls := object class.
baseCls := self baseInspectedObjectClass.
nNamedInstvarsShown := cls instSize.
"/ only the namedInstvars below baseInspectedObjectClass
"/ are shown ...
(cls includesBehavior:baseCls) ifTrue:[
nNamedInstvarsShown := nNamedInstvarsShown - baseCls instSize.
].
nExtraNamedInstvarsShown := self extraNamedFields size.
idx <= (nNamedInstvarsShown+nExtraNamedInstvarsShown) ifTrue:[
^ nil "/ named instVar selected.
].
^ idx - (nNamedInstvarsShown+nExtraNamedInstvarsShown).
"Modified: / 04-08-2006 / 11:45:42 / cg"
!
namedFieldAt:idx
^ object instVarAt:idx
!
namedFieldAt:idx put:newValue
^ object instVarAt:idx put:newValue
!
namedFieldList
"return a list of instVar names to show in the selectionList."
|aList cls baseCls|
cls := object class.
baseCls := self baseInspectedObjectClass.
aList := OrderedCollection new.
aList addAll:(cls allInstVarNames).
(cls includesBehavior:baseCls) ifTrue:[
"/ hide some stuff
aList := aList copyFrom:(self baseInspectedObjectClass instSize + 1).
].
^ aList
"Modified: / 18-09-2006 / 21:35:30 / cg"
!
pseudoFieldNames
"return a list of names to show in the selectionList.
Leave hasMore as true, if a '...' entry should be added."
|list cls|
cls := object class.
list := OrderedCollection new.
list add:'-' , 'self' allItalic.
list add:'-' , 'local messages' allItalic.
"/ list add:'-' , 'inherited messages' allItalic.
list add:'-' , 'all messages' allItalic.
list add:'-' , 'hash' allItalic.
list add:'-' , 'identityHash' allItalic.
cls hasImmediateInstances ifFalse:[
object dependents notEmptyOrNil ifTrue:[
list add:'-' , 'dependents' allItalic.
].
].
cls instSize > 0 ifTrue:[
list add:'-' , 'all inst vars' allItalic.
].
((cls isVariable) and:[self showAllIndexedVarsInFieldList]) ifTrue:[
list add:'-' , 'all indexed vars' allItalic.
].
^ list
!
pseudoFieldNamesWithIndexed:withIndexed
"return a list of names to show in the selectionList.
Leave hasMore as true, if a '...' entry should be added."
|list cls|
cls := object class.
list := OrderedCollection new.
list add:'-' , 'self' allItalic.
list add:'-' , 'local messages' allItalic.
"/ list add:'-' , 'inherited messages' allItalic.
list add:'-' , 'all messages' allItalic.
list add:'-' , 'hash' allItalic.
list add:'-' , 'identityHash' allItalic.
cls hasImmediateInstances ifFalse:[
object dependents notEmptyOrNil ifTrue:[
list add:'-' , 'dependents' allItalic.
].
].
cls instSize > 0 ifTrue:[
list add:'-' , 'all inst vars' allItalic.
].
(withIndexed and:[self showAllIndexedVarsInFieldList]) ifTrue:[
list add:'-' , 'all indexed vars' allItalic.
].
^ list
!
setAcceptAction
"set the codeViews accept action"
|idx acceptAction sel|
acceptAction := [:theText | self doAccept:theText asString].
idx := self theSingleSelectionIndex.
(idx isNil
or:[ object class hasImmediateInstances])
ifTrue:[
acceptAction := nil.
] ifFalse:[
sel := listView at:idx.
(sel startsWith:'-all') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-hash') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-identityHash') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-dependents') ifTrue:[
acceptAction := nil.
].
(sel startsWith:'-source') ifTrue:[
acceptAction := nil.
].
].
workspace acceptAction:acceptAction.
!
setDoItAction
"set the codeViews doit action"
workspace
doItAction:[:theCode |
|evaluator|
(evaluator := object class evaluatorClass)
notNil ifTrue:[
evaluator
evaluate:theCode
in:nil
receiver:object
notifying:workspace
logged:true
ifFail:nil
] ifFalse:[
'objects class provides no evaluator'
]
].
object class evaluatorClass isNil ifTrue:[
workspace doItAction:nil.
workspace acceptAction:nil.
]
"Modified: 1.8.1997 / 21:47:09 / cg"
!
showAllIndexedVarsInFieldList
^ true
!
showMore
|o|
hasMore ifTrue:[
nShown := nShown * 2.
"/ force update (which is otherwise ignored)
o := object.
inspectedObject := object := nil.
self inspect:o
]
"Modified: / 26.8.1998 / 19:05:25 / cg"
!
stringWithAllIndexedVarValues
|nIdx s names maxLen varString padLeft|
nIdx := object size.
s := CharacterWriteStream on:''.
names := self indexList.
names size > 0 ifTrue:[
maxLen := (names collect:[:eachName | eachName printString size]) max.
padLeft := names conform:[:eachIdx | eachIdx isInteger].
names do:[:eachIdx |
|val|
padLeft ifTrue:[
s nextPutAll:(eachIdx printStringLeftPaddedTo:maxLen).
] ifFalse:[
s nextPutAll:((eachIdx printString , ' ') paddedTo:maxLen+1 with:$.).
].
s nextPutAll:' : '.
val := self indexedValueAtKey:eachIdx.
varString := self basicDisplayStringForValue:val.
(varString includes:Character cr) ifTrue:[
varString := varString copyTo:(varString indexOf:Character cr)-1.
varString := varString , '...'.
].
s nextPutLine:varString.
].
].
nShown < nIdx ifTrue:[
s nextPutLine:' ...'.
].
^ s contents
!
stringWithAllInstVarValues
|s names maxLen varString|
s := CharacterWriteStream on:''.
names := object class allInstVarNames.
maxLen := (names collect:[:eachName | eachName size]) max.
names keysAndValuesDo:[:eachInstVarIndex :eachInstVarName |
s nextPutAll:((eachInstVarName , ' ') paddedTo:maxLen+1 with:$.).
s nextPutAll:' : '.
varString := self basicDisplayStringForValue:(object instVarAt:eachInstVarIndex).
(varString includes:Character cr) ifTrue:[
varString := varString copyTo:(varString indexOf:Character cr)-1.
varString := varString , '...'.
].
s nextPutAll:varString.
s cr.
].
^ s contents
!
stringWithMessages:which
|cls s messages |
s := CharacterWriteStream on:''.
cls := object class.
which == #local ifTrue:[
messages := cls selectors.
] ifFalse:[
which == #all ifTrue:[
messages := cls allSelectors.
] ifFalse:[
messages := cls allSelectors copy asSet removeAll:cls selectors; yourself.
].
].
messages asOrderedCollection sort do:[:eachSelector |
s nextPutAll:eachSelector.
s cr.
].
^ s contents
!
theSingleSelectionIndex
"helper - return the index of the (single) selected entry.
Nil if nothing or multiple items are selected"
|idx|
idx := selectionIndex.
idx isCollection ifTrue:[
selectionIndex size == 1 ifTrue:[
^ selectionIndex first
].
^ nil
].
^ selectionIndex
!
valueAtLine:lineNr
"helper - return the value of the selected entry"
|idx l val|
(self hasSelfEntry
and:[lineNr == 1 or:[lineNr isNil]]) ifTrue:[
^ object
].
((l := listView at:lineNr) startsWith:$-) ifTrue:[
(l ~= '-' and:[(l at:2) isDigit not "negative number"]) ifTrue:[
^ self valueForSpecialLine:(listView at:lineNr)
].
].
"/ a named instVar ?
idx := self instVarIndexForLine:lineNr.
idx notNil ifTrue:[
BreakPointInterrupt catch:[
^ self namedFieldAt:idx
]
].
"/ an extra named field ?
idx := self extraNamedVarIndexForLine:lineNr.
idx notNil ifTrue:[
BreakPointInterrupt catch:[
val := ((self extraNamedFields) at:idx) value.
val isBlock ifTrue:[ val := val value ].
^ val
]
].
"/ an indexed instVar ?
idx := self keyIndexForLine:lineNr.
idx notNil ifTrue:[
BreakPointInterrupt catch:[
^ self indexedValueAtIndex:idx.
]
].
"/ nope
^ nil
"Modified: / 03-08-2006 / 14:05:30 / cg"
!
valueAtLine:lineNr put:newValue
|idx|
idx := self instVarIndexForLine:selectionIndex.
idx notNil ifTrue:[
self namedFieldAt:idx put:newValue.
^ self.
].
idx := self keyIndexForLine:selectionIndex.
idx notNil ifTrue:[
self indexedValueAtIndex:idx put:newValue.
^ self
].
^ self "/ self selected - dont store
!
valueForSpecialLine:line
|idx fieldEntry extraAttributes|
extraAttributes := object inspectorExtraAttributes.
(extraAttributes notNil and:[ extraAttributes includesKey:line ]) ifTrue:[
^ (extraAttributes at:line) value
].
idx := self derivedFieldNames indexOf:line.
idx ~~ 0 ifTrue:[
fieldEntry := self derivedFields at:idx.
] ifFalse:[
idx := self extraNamedFieldNames indexOf:line.
idx ~~ 0 ifTrue:[
fieldEntry := self extraNamedFields at:idx.
].
].
fieldEntry notNil ifTrue:[
fieldEntry isAssociation ifTrue:[
^ fieldEntry value
].
^ fieldEntry at:2.
].
(line startsWith:'-self') ifTrue:[
^ object
].
(line startsWith:'-size') ifTrue:[
^ object size
].
(line startsWith:'-hash') ifTrue:[
^ object hash
].
(line startsWith:'-identityHash') ifTrue:[
^ object identityHash
].
(line startsWith:'-dependents') ifTrue:[
^ object dependents
].
(line startsWith:'-all') ifTrue:[
^ object
].
(line startsWith:'-local messages') ifTrue:[
^ object
].
(line startsWith:'-inherited messages') ifTrue:[
^ object
].
(line startsWith:'-all messages') ifTrue:[
^ object
].
self error:'unknown special line'.
"Created: / 31-10-2001 / 09:17:45 / cg"
"Modified: / 18-09-2006 / 21:34:54 / cg"
! !
!InspectorView methodsFor:'queries'!
canInspect:anObject
^ anObject inspectorClass == self class
!
compilerClass
^ object class compilerClass
!
dereferenceValueHolders
^ dereferenceValueHolders ? false
!
labelFor:anObject
"return the windowLabel to use in my topView, when inspecting anObject."
|lbl id|
(self class == InspectorView
and:[anObject inspectorClass ~~ InspectorView]) ifTrue:[
lbl := 'BasicInspector on: '
] ifFalse:[
lbl := 'Inspector on: '
].
(anObject isImmediate
or:[anObject isBoolean]) ifFalse:[
lbl := lbl , '<%2> '
].
lbl := lbl , '%1'.
IdDictionary isNil ifTrue:[
IdDictionary := WeakIdentityDictionary new.
].
[
id := IdDictionary
at:anObject
ifAbsentPut:[
|nextID|
nextID := NextSequentialID ? 0.
NextSequentialID := nextID + 1.
nextID
].
] valueUninterruptably.
^ self class classResources
string:lbl
with:(self labelNameFor:anObject)
with:id
!
labelNameFor:anObject
"return the iconLabel to use in my topView, when inspecting anObject.
Simply returns the className or name of anObjects class"
|s|
anObject isClass ifTrue:[
s := anObject displayString
] ifFalse:[
(anObject isImmediate
or:[anObject isBoolean]) ifTrue:[
s := anObject printString , ', ' , anObject classNameWithArticle
] ifFalse:[
s := anObject classNameWithArticle
].
].
s isNil ifTrue:[
anObject isBehavior ifTrue:[
^ 'someBehavior'
].
^ 'something'
].
^ s
"
1234 inspect
true inspect
$a inspect
"
!
selectedKeyName
selectionIndex notNil ifTrue:[
^ listView listAt:selectionIndex.
].
^ nil
!
suppressPseudoSlots
^ suppressPseudoSlots ? false
! !
!InspectorView methodsFor:'selection'!
basicDisplayStringForValue:someValue
"return the value's displayString to be pasted into the workspace."
|s|
Error handle:[:ex |
s := someValue classNameWithArticle.
displayStringMessage == #displayString ifTrue:[
s := s , ' "error in displayString: ' , ex description , '"'
] ifFalse:[
s := s , ' "error in displayString (' , displayStringMessage , '): ' , ex description , '"'
].
^ s
] do:[
integerDisplayRadix ~= 10 ifTrue:[
"/ not everything can be shown in HEX/Binary
someValue isInteger ifTrue:[
^ someValue radixPrintStringRadix:integerDisplayRadix
].
(someValue isMemberOf:ByteArray) ifTrue:[
s := WriteStream on:(String new:10).
s writeLimit:100000.
someValue printOn:s base:integerDisplayRadix showRadix:true.
^ s contents
]
].
"/ displayStringMessage := #classNameWithArticle
"/ displayStringMessage := #displayString
"/ displayStringMessage := #printString
s := CharacterWriteStream on:(String new:10).
s writeLimit:100000.
someValue isLazyValue ifTrue:[
s nextPutAll:someValue class nameWithArticle
] ifFalse:[
"/ mhmh - avoid sending #perform: (bad for proxy objects which pass it to somewhere..)
displayStringMessage == #displayString ifTrue:[
someValue displayOn:s.
"/ s := someValue displayString.
] ifFalse:[
displayStringMessage == #printString ifTrue:[
someValue printOn:s.
"/ s := someValue printString.
] ifFalse:[
displayStringMessage == #storeString ifTrue:[
someValue storeOn:s.
"/ s := someValue storeString.
] ifFalse:[
^ someValue perform:displayStringMessage.
].
].
].
].
^ s contents
].
"Modified: / 24-08-2010 / 17:29:08 / cg"
!
displayStringForValue:someValue
"return the value's displayString to be pasted into the workspace."
|idx sel extraAttributes|
idx := self theSingleSelectionIndex.
idx notNil ifTrue:[
sel := listView at:idx.
extraAttributes := object inspectorExtraAttributes.
(extraAttributes notNil and:[extraAttributes includesKey:sel]) ifTrue:[
^ someValue "(extraAttributes at:sel) value" printString
].
(sel startsWith:'-all inst vars') ifTrue:[
^ self stringWithAllInstVarValues
].
(sel startsWith:'-all indexed vars') ifTrue:[
^ self stringWithAllIndexedVarValues
].
(sel startsWith:'-all messages') ifTrue:[
^ self stringWithMessages:#all
].
(sel startsWith:'-local messages') ifTrue:[
^ self stringWithMessages:#local
].
(sel startsWith:'-inherited messages') ifTrue:[
^ self stringWithMessages:#inherited
].
].
^ self basicDisplayStringForValue:someValue
"Modified: / 17-11-2010 / 19:20:47 / cg"
!
selection:lineNr
self showSelection:lineNr
!
showSelection:lineNr
"user clicked on an instvar - show value in workspace"
|listSize val|
listSize := listView list size.
listSize == 0 ifTrue:[^ self].
(hasMore and:[lineNr == listSize]) ifTrue:[
"clicked on the '...' entry"
self showMore.
listView setSelection:lineNr.
].
self hasSelfEntry ifTrue:[
(self hasSelfEntry and:[lineNr == 1]) ifTrue:[
"selecting self also does a re-set, this allows updating the list"
self reinspect.
].
].
selectionIndex := selectedLine := lineNr.
val := self selection.
self showValue:val.
self setAcceptAction.
"Modified: / 03-08-2006 / 14:26:22 / cg"
!
showValue:someValue
"user clicked on an entry - show value in workspace"
|s|
self "topView" withWaitCursorDo:[
s := self displayStringForValue:someValue.
s = workspace selectionAsString ifFalse:[
workspace replace:s.
].
].
"Modified: / 30-11-2010 / 18:56:55 / cg"
! !
!InspectorView methodsFor:'user interaction'!
doAccept:theText
|sel newValue|
sel := listView at:(self theSingleSelectionIndex).
(sel startsWith:'-all') ifTrue:[
workspace flash.
^ self.
].
Error handle:[:ex |
workspace flash
] do:[
newValue := object class evaluatorClass
evaluate:theText
receiver:object
notifying:workspace.
self dereferenceValueHolders ifTrue:[
(self valueAtLine:selectionIndex) value:newValue
] ifFalse:[
self valueAtLine:selectionIndex put:newValue.
]
]
!
doCopyKey
"put the instVar-name into the text-copy-buffer"
|nm selIdx|
(selIdx := self theSingleSelectionIndex) notNil ifTrue:[
nm := listView listAt:selIdx.
nm notNil ifTrue:[
self setClipboardText:(nm asString)
]
]
!
doInspect:basic
"user selected inspect-menu entry"
|objectToInspect|
objectToInspect := self selection ? object.
objectToInspect notNil ifTrue:[
(basic == #new and:[NewInspector::NewInspectorView notNil]) ifTrue:[
NewInspector::NewInspectorView inspect:objectToInspect
] ifFalse:[
basic ifTrue:[
objectToInspect basicInspect
] ifFalse:[
objectToInspect inspect
]
].
].
"Modified: / 31.10.1997 / 12:46:53 / cg"
!
doUpdate
self reinspect
!
monitor:anInstVarName
"start a monitoring process, showing the given instVar
in regular intervals."
|ivName|
(ivName := anInstVarName) isInteger ifTrue:[
ivName := anInstVarName printString
].
listView selectElement:ivName.
self doStartMonitor
"Created: / 1.3.1996 / 19:31:45 / cg"
"Modified: / 12.2.1999 / 16:05:47 / cg"
!
selection
"helper - return the value of the (single) selected entry.
Nil if nothing or multiple items are selected"
|idx val|
idx := self theSingleSelectionIndex.
idx isNil ifTrue:[^ nil].
val := self valueAtLine:idx.
self dereferenceValueHolders ifTrue:[
"workspace-variable-inspection"
val := val value
].
^ val
"Modified: / 03-08-2006 / 14:27:02 / cg"
!
setDisplayRadixTo10
self setDisplayRadixTo:10
"Created: / 24-08-2010 / 17:26:12 / cg"
!
setDisplayRadixTo16
self setDisplayRadixTo:16
"Created: / 24-08-2010 / 17:26:22 / cg"
!
setDisplayRadixTo2
self setDisplayRadixTo:2
"Created: / 24-08-2010 / 17:26:18 / cg"
!
setDisplayRadixTo:radix
|sel|
integerDisplayRadix := radix.
self reinspect.
sel := listView selection.
sel notNil ifTrue:[
self showSelection:sel
]
"Created: / 24-08-2010 / 17:26:54 / cg"
!
showLast
"user clicked on an instvar - show value in workspace"
|lastIdx|
lastIdx := listView list size.
lastIdx ~~ 0 ifTrue:[
self showSelection:lastIdx.
listView selection:lastIdx.
]
"Created: 28.6.1996 / 15:06:38 / cg"
"Modified: 18.3.1997 / 18:22:54 / cg"
!
tryToSelectKeyNamed:aString
|list idx|
list := listView list.
list notNil ifTrue:[
(idx := list indexOf:aString) ~= 0 ifTrue:[
listView selection:idx
].
].
"Created: / 16.11.2001 / 13:48:51 / cg"
! !
!InspectorView methodsFor:'workspace protocol'!
modified:aBoolean
^ workspace modified:aBoolean
!
saveAs:file doAppend:doAppend
workspace saveAs:file doAppend:doAppend
! !
!InspectorView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.231 2011-02-05 15:19:05 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.231 2011-02-05 15:19:05 cg Exp $'
! !