[squeak-dev] The Inbox: Tools-cbc.971.mczThiede, Christoph Christoph.Thiede at student.hpi.uni-potsdam.deFri Jun 5 18:32:33 UTC 2020
Sorry, your ancestry is wrong as you will see when you read this mail. Make sure to install Trunk updates before, merge the latest Trunk version of Tools, and reparent it. :-) Best, Christoph <http://www.hpi.de/> ________________________________ Von: Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im Auftrag von commits at source.squeak.org <commits at source.squeak.org> Gesendet: Freitag, 5. Juni 2020 19:47:27 An: squeak-dev at lists.squeakfoundation.org Betreff: [squeak-dev] The Inbox: Tools-cbc.971.mcz Chris Cunningham uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-cbc.971.mcz ==================== Summary ==================== Name: Tools-cbc.971 Author: cbc Time: 5 June 2020, 10:47:25.321315 am UUID: a26c3f51-a32c-564e-93a7-81ff7ce1e212 Ancestors: Tools-mt.944, Tools-mt.970 Enhance ObjectExlporer>>copyValue to copy a string that would re-constitute the base value using the representation show in the explorer. An explicit example: If your are exploring the integer 42 and choose the menu item 'copy value' from the menu while hovering over the "binary '0010 1010'" (or "binary '101010"), it will copy the string '2r101010' to the clipboard. This is extensible to other objects as well, but currently only supports Integer display options. =============== Diff against Tools-mt.970 =============== Item was removed: - (PackageInfo named: 'Tools') preamble: 'Project current isMorphic ifTrue: [ - | windows | - windows := SystemWindow - windowsIn: Project current world - satisfying: [:window | window visible and: [window model isKindOf: Inspector] ]. - Smalltalk globals - at: #ObjectsUnderInspection - put: (windows collect: [:ea | ea model object]). - windows do: [:window | [window delete] valueSupplyingAnswer: true]].'! Item was removed: - ----- Method: Bag>>inspectorClass (in category '*Tools-Inspector') ----- - inspectorClass - - ^ BagInspector! Item was removed: - DictionaryInspector subclass: #BagInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! - - !BagInspector commentStamp: 'mt 4/2/2020 10:32' prior: 0! - I am an inspector for bags. I specialize the inspector for dictionaries because I expose the internal dictionary all bags use.! Item was removed: - ----- Method: BagInspector>>addElement: (in category 'menu commands') ----- - addElement: anObject - - self object add: anObject. - self updateFields. - self selectElementAt: anObject.! Item was removed: - ----- Method: BagInspector>>elementGetterAt: (in category 'private') ----- - elementGetterAt: element - "Return a way to access the number of occurrences in the bag for the given element." - - ^ [:bag | (bag instVarNamed: #contents) at: element]! Item was removed: - ----- Method: BagInspector>>elementIndices (in category 'initialization') ----- - elementIndices - - ^ [ (object instVarNamed: #contents) keysInOrder ] ifError: [ - "Can occur when debugging Bag new" - Array empty ].! Item was removed: - ----- Method: BagInspector>>elementSetterAt: (in category 'private') ----- - elementSetterAt: element - "Change the number of occurrences for the given element." - - ^ [:bag :count | (bag instVarNamed: #contents) at: element put: count]! Item was removed: - ----- Method: BagInspector>>isBindingSelected (in category 'bindings') ----- - isBindingSelected - - ^ false! Item was removed: - ----- Method: BagInspector>>removeSelectedElement (in category 'menu commands') ----- - removeSelectedElement - - self object remove: self selectedKey.! Item was changed: Inspector subclass: #BasicInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! - - !BasicInspector commentStamp: 'mt 3/30/2020 14:38' prior: 0! - I am an Inspector that sends as few messages as possible to collect information about the inspected object. For example, use me to inspect proxies, which are typically subclasses of ProtoObject and hence understand only little messages but make heay use of #doesNotUnderstand:.! Item was removed: - ----- Method: BasicInspector class>>openOn:withLabel: (in category 'as yet unclassified') ----- - openOn: anObject withLabel: label - "Ignore label." - - ^ ToolBuilder open: (self on: anObject)! Item was removed: - ----- Method: BasicInspector>>basicObjectPrintString (in category 'initialization') ----- - basicObjectPrintString - - ^ 'a {1}({2})' format: {thisContext objectClass: object. object identityHash}! Item was removed: - ----- Method: BasicInspector>>fieldObjectClass (in category 'fields') ----- - fieldObjectClass - - ^ (self newFieldForType: #proto key: #class) - name: 'class'; emphasizeName; - valueGetter: [:object | thisContext objectClass: object]; - valueGetterExpression: 'thisContext objectClass: self'; - yourself! Item was removed: - ----- Method: BasicInspector>>fieldObjectSize (in category 'fields') ----- - fieldObjectSize - - ^ (self newFieldForType: #proto key: #size) - name: 'size'; emphasizeName; - valueGetter: [:object | thisContext objectSize: object]; - valueGetterExpression: 'thisContext objectSize: self'; - yourself! Item was removed: - ----- Method: BasicInspector>>fieldSelf (in category 'fields') ----- - fieldSelf - - ^ (self newFieldForType: #self key: #self) - name: 'self'; emphasizeName; - valueGetter: [:object | self basicObjectPrintString]; printValueAsIs; - valueGetterExpression: 'self'; - valueSetter: [:object :value | self object: value]; "Switch to another object-under-inspection." - yourself! Item was changed: + ----- Method: BasicInspector>>inspect: (in category 'initialize-release') ----- - ----- Method: BasicInspector>>inspect: (in category 'initialization') ----- inspect: anObject + "Initialize the receiver so that it is inspecting anObject. There is no + current selection." + + self initialize. + object := anObject. + selectionIndex := 0. + contents := ''! - "We don't want to change the inspector class. Only set anObject as the inspectee." - self object: anObject! Item was removed: - ----- Method: BasicInspector>>labelString (in category 'initialization') ----- - labelString - - ^ '{1} {2}{3}' format: { - '[basic]'. - self basicObjectPrintString. - (self object isReadOnlyObject - ifTrue: [' (read-only)'] - ifFalse: [''])}! Item was removed: - ----- Method: BasicInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- - streamBaseFieldsOn: aStream - - aStream - nextPut: self fieldSelf; - nextPut: self fieldObjectClass; - nextPut: self fieldObjectSize.! Item was removed: - ----- Method: BasicInspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- - streamIndexedVariablesOn: aStream - "Truncate indexed variables if there are too many of them." - - self - streamOn: aStream - truncate: (1 to: (thisContext objectSize: self object)) - collectFields: [:index | - (self newFieldForType: #indexed key: index) - name: index asString; - valueGetter: [:object | thisContext object: object basicAt: index]; - valueGetterExpression: ('thisContext object: {1} basicAt: {2}' format: { 'self'. index }); - valueSetter: [:object :value | thisContext object: object basicAt: index put: value]; - yourself]! Item was removed: - ----- Method: BasicInspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- - streamInstanceVariablesOn: aStream - - (thisContext objectClass: self object) allInstVarNames doWithIndex: [:name :index | - aStream nextPut: ((self newFieldForType: #instVar key: name) - name: name asString; - shouldStyleName: true; - valueGetter: [:object | thisContext object: object instVarAt: index]; - valueGetterExpression: ('thisContext object: {1} instVarAt: {2}' format: { 'self'. index }); - valueSetter: [:object :value | thisContext object: object instVarAt: index put: value]; - yourself)].! Item was changed: ----- Method: Behavior>>toolIconSelector: (in category '*Tools-icons') ----- toolIconSelector: aSymbol "Tools can annotate the method identified by aSymbol with an icon identified by the symbol this method returns. We customize this for, eg, overriden methods or methods with breaks. Defaults to no icon" self methodDictionary at: aSymbol ifPresent: [ :method | method hasBreakpoint ifTrue: [^ #breakpoint]. + method messagesDo: [:messageSelector | - method selectorsDo: [:messageSelector | (#(halt halt: haltIfNil haltIf: haltOnce haltOnce: haltOnCount: halt:onCount: break) includes: messageSelector) ifTrue: [^ #breakpoint]. (#(flag: needsWork notYetImplemented) includes: messageSelector) ifTrue: [^ #flag]. (#(shouldBeImplemented subclassResponsibility) includes: messageSelector) ifTrue: [ (self isSelectorOverridden: aSymbol) ifTrue: [^ #abstract] ifFalse: [^ #notOverridden]]. messageSelector == #shouldNotImplement ifTrue: [^ #no]]. method hasReportableSlip ifTrue: [^ #breakpoint]]. (self isSelectorOverride: aSymbol) ifTrue: [ (self isSelectorOverridden: aSymbol) ifTrue: [ ^ #arrowUpAndDown ] ifFalse: [ ^ #arrowUp ] ] ifFalse: [ (self isSelectorOverridden: aSymbol) ifTrue: [^ #arrowDown ]]. self methodDictionary at: aSymbol ifPresent: [ :method | (method primitive ~= 0 and: [method isQuick not]) ifTrue: [^ #primitive]]. ^ #blank! Item was removed: - ----- Method: Bitset>>inspectorClass (in category '*Tools-Inspector') ----- - inspectorClass - - ^ BitsetInspector! Item was removed: - CollectionInspector subclass: #BitsetInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! - - !BitsetInspector commentStamp: 'mt 4/22/2020 08:13' prior: 0! - I am an inspector for bit sets. I display bits with zero based indexing corresponding to the bit numbering conventions of a bit field.! Item was removed: - ----- Method: BitsetInspector>>addElement: (in category 'menu - commands') ----- - addElement: anInteger - "Flip the specified bit to 1 and select it. Note that there is no need to #updateFields here because of the bitset's semantics for #add:." - - self object add: anInteger. - self selectElementAt: anInteger.! Item was removed: - ----- Method: BitsetInspector>>elementIndices (in category 'private') ----- - elementIndices - - ^ 0 to: self objectSize - 1! Item was removed: - ----- Method: BitsetInspector>>fieldSize (in category 'fields') ----- - fieldSize - - ^ (self newFieldForType: #misc key: #size) - name: 'num 1 bits' translated; emphasizeName; - valueGetter: [:bitset | bitset size]; - yourself! Item was removed: - ----- Method: BitsetInspector>>objectSize (in category 'private') ----- - objectSize - - ^ self object capacity! Item was removed: - ----- Method: BitsetInspector>>removeSelectedElement (in category 'menu - commands') ----- - removeSelectedElement - "Flip the selected bit back to 0." - - self selectedField setValueFor: self to: 0.! Item was removed: - ----- Method: BitsetInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- - streamBaseFieldsOn: aStream - - super streamBaseFieldsOn: aStream. - aStream nextPut: self fieldSize.! Item was removed: - ----- Method: Browser>>browseClassHierarchy (in category 'multi-window support') ----- - browseClassHierarchy - "Overridden to consider multi-window state and hierarchy browser." - - | behavior newBrowser | - (behavior := self selectedClassOrMetaClass) isNil ifTrue: - [^self]. - - (self isPackage "PackageBrowser panes can't support a hierarchy browser; not sure why." - or: [self multiWindowState isNil]) ifTrue: - [^super browseClassHierarchy]. - - (newBrowser := HierarchyBrowser new initHierarchyForClass: behavior) - selectMessageCategoryNamed: self selectedMessageCategoryName; - selectMessageNamed: self selectedMessageName; - editSelection: editSelection. - - self multiWindowState addWindow: newBrowser! Item was added: + ----- Method: Browser>>classHierarchy (in category 'multi-window support') ----- + classHierarchy + | behavior newBrowser | + (behavior := self selectedClassOrMetaClass) isNil ifTrue: + [^self]. + + (self isPackage "PackageBrowser pains can't support a hierarchy browser; not sure why." + or: [self multiWindowState isNil]) ifTrue: + [^super classHierarchy]. + + (newBrowser := HierarchyBrowser new initHierarchyForClass: behavior) + selectMessageCategoryNamed: self selectedMessageCategoryName; + selectMessageNamed: self selectedMessageName; + editSelection: editSelection. + + self multiWindowState addWindow: newBrowser + ! Item was changed: ----- Method: Browser>>defaultBrowserTitle (in category 'initialize-release') ----- defaultBrowserTitle + ^ 'System Browser'! - | title | - title := 'System Browser'. - ^ self environment = self class environment - ifTrue: [title] - ifFalse: [title, ' on environment ', self environment asString]! Item was changed: ----- Method: Browser>>mainMessageListMenu: (in category 'message functions') ----- mainMessageListMenu: aMenu <messageListMenuShifted: false> ^ aMenu addList: #( ('what to show...' offerWhatToShowMenu) ('toggle break on entry' toggleBreakOnEntry) - ('browse full (b)' browseMethodFull) + ('browse hierarchy (h)' classHierarchy) - ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) ('copy selector (c)' copySelector) ('copy reference (C)' copyReference) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) ('class refs (N)' browseClassRefs) - ('remove method (x)' removeMessage) ('explore method' exploreMethod) ('inspect method' inspectMethod)); yourself ! Item was removed: - ----- Method: ChangeList class>>browseMethodVersions (in category 'public access') ----- - browseMethodVersions - - | changeList end changesFile filteredRecords | - changesFile := (SourceFiles at: 2) readOnlyCopy. - changesFile setConverterForCode. - end := changesFile size. - changeList := self new. - Cursor read showWhile: [ - [changeList scanFile: changesFile from: 0 to: end] - on: InvalidUTF8 do: [:err | err resume: '']]. - changesFile close. - - filteredRecords := Dictionary new. - changeList changeList - do: [:changeRecord | - changeRecord methodSelector ifNotNil: [:selector | - | class | - class := changeRecord methodClass. - "Only collect records that point to not-installed methods." - (class isNil or: [(class includesSelector: selector) not]) ifTrue: [ - (filteredRecords at: selector ifAbsentPut: [OrderedCollection new]) - add: changeRecord]]] - displayingProgress: [:changeRecord | 'Parsing source code at {1}...' format: {changeRecord position}]. - filteredRecords explore. "Open explorer to allow user to repeat the following step manually." - self browseMethodVersions: filteredRecords.! Item was removed: - ----- Method: ChangeList class>>browseMethodVersions: (in category 'public access') ----- - browseMethodVersions: filteredRecords - - | changeList sortedKeys choice | - sortedKeys := filteredRecords keys sorted. - choice := Project uiManager chooseFrom: sortedKeys values: sortedKeys title: 'Recover method versions'. - choice ifNil: [^ self]. - - "Only ChangeList can handle the mix of (maybe non-existing) class references in records. For example, VersionsBrowser is not supported." - changeList := ChangeList new. - - (filteredRecords at: choice) do: [:changeRecord | - changeList - addItem: changeRecord - text: ('{1} {2}{3}{4} \{{5}\}' format: { - changeRecord stamp. - changeRecord methodClassName. - changeRecord isMetaClassChange - ifTrue: [' class '] ifFalse: [' ']. - choice. - changeRecord category})]. - changeList resetListSelections. - - self - open: changeList - name: 'All local versions for ', choice storeString - multiSelect: false! Item was removed: - ----- Method: ChangeList>>resetListSelections (in category 'initialization-release') ----- - resetListSelections - - listSelections := Array new: list size withAll: false.! Item was changed: ----- Method: ChangeList>>scanCategory (in category 'scanning') ----- scanCategory "Scan anything that involves more than one chunk; method name is historical only" + | itemPosition item tokens stamp anIndex | - | itemPosition item tokens stamp anIndex class meta | itemPosition := file position. item := file nextChunk. ((item includesSubstring: 'commentStamp:') or: [(item includesSubstring: 'methodsFor:') + or: [item endsWith: 'reorganize']]) ifFalse: - or: [(item includesSubstring: 'classDefinition:') - or: [item endsWith: 'reorganize']]]) ifFalse: ["Maybe a preamble, but not one we recognize; bail out with the preamble trick" ^ self addItem: (ChangeRecord new file: file position: itemPosition type: #preamble) text: ('preamble: ' , item contractTo: 50)]. tokens := Scanner new scanTokens: item. tokens size >= 3 ifTrue: [stamp := ''. anIndex := tokens indexOf: #stamp: ifAbsent: [nil]. anIndex ifNotNil: [stamp := tokens at: (anIndex + 1)]. tokens second == #methodsFor: ifTrue: [^ self scanCategory: tokens third class: tokens first meta: false stamp: stamp]. tokens third == #methodsFor: ifTrue: [^ self scanCategory: tokens fourth class: tokens first meta: true stamp: stamp]]. tokens second == #commentStamp: ifTrue: [stamp := tokens third. self addItem: (ChangeRecord new file: file position: file position type: #classComment class: tokens first category: nil meta: false stamp: stamp) text: 'class comment for ' , tokens first, (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp]). file nextChunk. ^ file skipStyleChunk]. - - tokens first == #classDefinition: - ifTrue: - [class := tokens second. - meta := tokens size >= 3 and: [tokens third = 'class']. - stamp := ''. - self addItem: - (ChangeRecord new file: file position: file position type: #classDefinition - class: class category: nil meta: meta stamp: stamp) - text: 'class definition for ' , class, - (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp]). - file nextChunk. - ^ file skipStyleChunk]. self assert: tokens last == #reorganize. self addItem: (ChangeRecord new file: file position: file position type: #reorganize class: tokens first category: nil meta: false stamp: stamp) text: 'organization for ' , tokens first, (tokens second == #class ifTrue: [' class'] ifFalse: ['']). file nextChunk! Item was changed: ----- Method: ChangeList>>scanFile:from:to: (in category 'scanning') ----- scanFile: aFile from: startPosition to: stopPosition file := aFile. changeList := OrderedCollection new. list := OrderedCollection new. listIndex := 0. file position: startPosition. 'Scanning ', aFile localName, '...' displayProgressFrom: startPosition to: stopPosition during: [:bar | | prevChar itemPosition item | [file position < stopPosition] whileTrue: [bar value: file position. [file atEnd not and: [file peek isSeparator]] whileTrue: [prevChar := file next]. (file peekFor: $!!) ifTrue: [(prevChar = Character cr or: [prevChar = Character lf]) ifTrue: [self scanCategory]] ifFalse: [itemPosition := file position. item := file nextChunk. file skipStyleChunk. item size > 0 ifTrue: [(item beginsWith: '----') ifTrue: [self addItem: (ChangeRecord new file: file position: itemPosition type: #misc) text: 'misc: ' , (item contractTo: 50)] ifFalse: [self addItem: (ChangeRecord new file: file position: itemPosition type: #doIt) text: 'do it: ' , (item contractTo: 50)]]]]]. + listSelections := Array new: list size withAll: false! - self resetListSelections.! Item was removed: - ----- Method: Class>>inspectorClass (in category '*Tools-Inspector') ----- - inspectorClass - - ^ ClassInspector! Item was removed: - Inspector subclass: #ClassInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! - - !ClassInspector commentStamp: 'mt 3/30/2020 14:47' prior: 0! - I am an Inspector that is specialized for inspecting Class objects. I show fields for my class variables and the shared pools I use.! Item was removed: - ----- Method: ClassInspector>>streamClassVariablesOn: (in category 'fields - streaming') ----- - streamClassVariablesOn: aStream - - self object classVarNames do: [:name | - aStream nextPut: ((self newFieldForType: #classVar key: name) - shouldStyleName: true; - valueGetter: [:object | object classPool at: name]; - valueSetter: [:object :value | object classPool at: name put: value]; - yourself)]! Item was removed: - ----- Method: ClassInspector>>streamSharedPoolsOn: (in category 'fields - streaming') ----- - streamSharedPoolsOn: aStream - - self object sharedPools doWithIndex: [:pool :index | - aStream nextPut: ((self newFieldForType: #poolDictionary key: (self environment keyAtIdentityValue: pool)) - shouldStyleName: true; - valueGetter: [:object | object sharedPools at: index]; - valueSetter: [:object :value | object sharedPools at: index put: value]; - yourself)].! Item was removed: - ----- Method: ClassInspector>>streamVariableFieldsOn: (in category 'fields - streaming') ----- - streamVariableFieldsOn: aStream - "Add fields for class variables and pool dictionaries." - - super streamVariableFieldsOn: aStream. - self - streamClassVariablesOn: aStream; - streamSharedPoolsOn: aStream.! Item was changed: ----- Method: CodeHolder>>messageListKey:from: (in category 'message list menu') ----- messageListKey: aChar from: view "Respond to a Command key. I am a model with a code pane, and I also have a listView that has a list of methods. The view knows how to get the list and selection." | sel class | aChar == $D ifTrue: [^ self toggleDiffing]. sel := self selectedMessageName. aChar == $m ifTrue: "These next two put up a type in if no message selected" [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self ]. aChar == $n ifTrue: [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self ]. aChar == $d ifTrue: [^ self removeMessageFromBrowser]. "The following require a class selection" (class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view]. aChar == $b ifTrue: [^ ToolSet browse: class selector: sel]. aChar == $N ifTrue: [^ self browseClassRefs]. aChar == $i ifTrue: [^ self methodHierarchy]. + aChar == $h ifTrue: [^ self classHierarchy]. - aChar == $h ifTrue: [^ self browseClassHierarchy]. aChar == $p ifTrue: [^ self browseFullProtocol]. aChar == $r ifTrue: [^ self browseVariableReferences]. aChar == $a ifTrue: [^ self browseVariableAssignments]. (aChar == $Y and: [self canShowMultipleMessageCategories]) ifTrue: [^ self showHomeCategory]. "The following require a method selection" sel ifNotNil: [aChar == $o ifTrue: [^ self fileOutMessage]. aChar == $c ifTrue: [^ self copySelector]. aChar == $v ifTrue: [^ self browseVersions]. aChar == $x ifTrue: [^ self removeMessage]. aChar == $C ifTrue: [ self copyReference ]]. ^ self arrowKey: aChar from: view! Item was changed: ----- Method: CodeHolder>>optionalButtonPairs (in category 'controls') ----- optionalButtonPairs "Answer a tuple (formerly pairs) defining buttons, in the format: button label selector to send help message" | aList | aList := #( ('browse' browseMethodFull 'view this method in a browser') ('senders' browseSendersOfMessages 'browse senders of...') ('implementors' browseMessages 'browse implementors of...') ('versions' browseVersions 'browse versions')), (Preferences decorateBrowserButtons ifTrue: [{#('inheritance' methodHierarchy 'browse method inheritance green: sends to super tan: has override(s) mauve: both of the above pink: is an override but doesn''t call super pinkish tan: has override(s), also is an override but doesn''t call super' )}] ifFalse: [{#('inheritance' methodHierarchy 'browse method inheritance')}]), #( + ('hierarchy' classHierarchy 'browse class hierarchy') - ('hierarchy' browseClassHierarchy 'browse class hierarchy') ('vars' browseVariableReferences 'references...')). ^ aList! Item was removed: - ----- Method: Collection>>inspectorClass (in category '*Tools-Inspector') ----- - inspectorClass - - ^ CollectionInspector! Item was removed: - Inspector subclass: #CollectionInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! - - !CollectionInspector commentStamp: 'mt 3/31/2020 10:18' prior: 0! - I am an Inspector that is specialized for inspecting collections. I provide extended access to the inspected collection's items, such as adding and removing items. - - Note that I can directly inspect instances of ArrayedCollection and alike.! Item was removed: - ----- Method: CollectionInspector>>addCollectionItemsTo: (in category 'menu - construction') ----- - addCollectionItemsTo: aMenu - - aMenu addLine. - super addCollectionItemsTo: aMenu. - - self object isReadOnlyObject ifTrue: [^ self]. - aMenu addTranslatedList: #( - ('refresh list view' updateFields) "--- useful in non-stepping debugger"). - - self canAddOrRemoveElements ifFalse: [^ self]. - aMenu addTranslatedList: #( - - - ('add element...' addElement)). - - self typeOfSelection = #element ifFalse: [^ self]. - aMenu addTranslatedList: #( - ('remove element (x)' removeSelection)).! Item was removed: - ----- Method: CollectionInspector>>addElement (in category 'menu - commands') ----- - addElement - - self addElement: ( - self - requestObject: 'Enter expression for new object' translated - orCancel: [^ self]).! Item was removed: - ----- Method: CollectionInspector>>addElement: (in category 'menu - commands') ----- - addElement: anObject - - self object add: anObject. - - self updateFields. - self selectFieldSuchThat: [:field | [(field getValueFor: self) == anObject] ifError: [false]]. - self hasSelection ifFalse: [self inform: ('The new element {1} was added.\\Yet, the list of fields is quite long. The new field\got truncated and is thus not visible.' translated withCRs format: {anObject printString})].! Item was removed: - ----- Method: CollectionInspector>>assertElementSelectedOr: (in category 'private') ----- - assertElementSelectedOr: aBlock - - ^ self typeOfSelection = #element - or: [aBlock cull: self selectedField]! Item was removed: - ----- Method: CollectionInspector>>canAddOrRemoveElements (in category 'private') ----- - canAddOrRemoveElements - "For simplicity, treat those properties together. There are no collections that support addition but deny removal of elements." - - ^ #(add: remove:ifAbsent:) noneSatisfy: [:selector | - (self object class lookupSelector: selector) hasLiteral: #shouldNotImplement]! Item was removed: - ----- Method: CollectionInspector>>elementGetterAt: (in category 'private') ----- - elementGetterAt: index - - ^ [:collection | collection at: index] ! Item was removed: - ----- Method: CollectionInspector>>elementIndices (in category 'private') ----- - elementIndices - - ^ 1 to: self objectSize! Item was removed: - ----- Method: CollectionInspector>>elementSetterAt: (in category 'private') ----- - elementSetterAt: index - - ^ [:collection :element | collection at: index put: element] ! Item was removed: - ----- Method: CollectionInspector>>inspectOne (in category 'menu - commands') ----- - inspectOne - "Only list the collection's elements. Ignore any other fields." - - self inspectOneOf: self elementIndices.! Item was removed: - ----- Method: CollectionInspector>>inspectorKey:from: (in category 'menu') ----- - inspectorKey: aChar from: view - - ^ aChar = $x - ifTrue: [self removeSelection] - ifFalse: [super inspectorKey: aChar from: view].! Item was removed: - ----- Method: CollectionInspector>>objectSize (in category 'private') ----- - objectSize - "For robustness. Partially initialized collections may fail to report their size. Useful for the debugger's inspectors." - - ^ [self object size] ifError: [0]! Item was removed: - ----- Method: CollectionInspector>>removeSelectedElement (in category 'menu - commands') ----- - removeSelectedElement - - self object remove: self selection.! Item was removed: - ----- Method: CollectionInspector>>removeSelection (in category 'menu - commands') ----- - removeSelection - "Keep the selection stable to support subsequent removals. Be robust against collections that do not allow elements to be removed such as arrays." - - | priorSelectionIndex | - super removeSelection. - - self assertElementSelectedOr: [^ self changed: #flash]. - priorSelectionIndex := self selectionIndex. - - [self removeSelectedElement] - ifError: [^ self changed: #flash]. - - self updateFields. - self selectionIndex: (priorSelectionIndex min: self fields size).! Item was removed: - ----- Method: CollectionInspector>>requestObject:initialAnswer:orCancel: (in category 'ui requests') ----- - requestObject: aMessageString initialAnswer: anAnswerString orCancel: aBlock - - | input | - input := Project uiManager - request: aMessageString - initialAnswer: anAnswerString. - input isEmptyOrNil ifTrue: [^ aBlock value]. - ^ Compiler evaluate: input for: self object! Item was removed: - ----- Method: CollectionInspector>>requestObject:orCancel: (in category 'ui requests') ----- - requestObject: aMessageString orCancel: aBlock - - ^ self - requestObject: aMessageString - initialAnswer: String empty - orCancel: aBlock! Item was removed: - ----- Method: CollectionInspector>>selectElementAt: (in category 'selection') ----- - selectElementAt: index - - self selectFieldSuchThat: [:field | field type = #element and: [field key = index]].! Item was removed: - ----- Method: CollectionInspector>>selectedElementIndex (in category 'selection') ----- - selectedElementIndex - - self assertElementSelectedOr: [^ nil]. - ^ self selectedField key! Item was removed: - ----- Method: CollectionInspector>>streamElementsOn: (in category 'fields - streaming') ----- - streamElementsOn: aStream - "Create a field for each element in the collection. Use the index' #printString (and not #asString) to reveal the nature of the key, which are usually integers (1, 2, 3, ...), but can be symbols (#apple, #tree, ...) or other objects (aMorph, aSocket, ...) in dictionary-like collections. Maybe #storeString would be even better but can be very expensive to compute." - - self - streamOn: aStream - truncate: self elementIndices - collectFields: [:index | - (self newFieldForType: #element key: index) - name: index printString; - valueGetter: (self elementGetterAt: index); - valueSetter: (self elementSetterAt: index); - yourself]! Item was removed: - ----- Method: CollectionInspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- - streamIndexedVariablesOn: aStream - "Override to rename 'index variables' to the collection's 'elements'." - - self streamElementsOn: aStream.! Item was changed: ----- Method: CompiledCode>>inspectorClass (in category '*Tools-Inspector') ----- inspectorClass "Answer the class of the inspector to be used on the receiver. Called by inspect; use basicInspect to get a normal (less useful) type of inspector." + ^ CompiledMethodInspector! - ^ CompiledCodeInspector! Item was removed: - Inspector subclass: #CompiledCodeInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! - - !CompiledCodeInspector commentStamp: 'ct 1/12/2020 15:21' prior: 0! - I am an inspector specialized for inspecting CompiledMethods.! Item was removed: - ----- Method: CompiledCodeInspector>>fieldByteCodes (in category 'fields') ----- - fieldByteCodes - - ^ (self newFieldForType: #all key: #byteCodes) - name: 'all bytecodes' translated; emphasizeName; - valueGetter: [:object | object symbolic]; printValueAsIs; - yourself! Item was removed: - ----- Method: CompiledCodeInspector>>fieldDecompile (in category 'fields') ----- - fieldDecompile - - ^ (self newFieldForType: #code key: #decompile) - name: 'decompiled' translated; emphasizeName; - valueGetter: [:compiledCode | compiledCode decompile decompileString]; printValueAsIs; - yourself! Item was removed: - ----- Method: CompiledCodeInspector>>fieldHeader (in category 'fields') ----- - fieldHeader - - ^ (self newFieldForType: #misc key: #header) - name: 'header' translated; emphasizeName; - valueGetter: [:object | object headerDescription]; printValueAsIs; - yourself! Item was removed: - ----- Method: CompiledCodeInspector>>fieldSource (in category 'fields') ----- - fieldSource - - ^ (self newFieldForType: #code key: #source) - name: 'source code' translated; emphasizeName; - valueGetter: [:compiledCode | '"{1}"\{2}' withCRs format: {compiledCode methodClass. compiledCode getSource}]; printValueAsIs; - shouldStyleValue: true; - yourself! Item was removed: - ----- Method: CompiledCodeInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- - streamBaseFieldsOn: aStream - "Instead of 'all inst vars' show all byte codes and header summary." - - aStream - nextPut: self fieldSelf; - nextPut: self fieldSource; - nextPut: self fieldDecompile; - nextPut: self fieldByteCodes; - nextPut: self fieldHeader.! Item was removed: - ----- Method: CompiledCodeInspector>>streamByteCodesOn: (in category 'fields - streaming') ----- - streamByteCodesOn: aStream - - self - streamOn: aStream - truncate: (self object initialPC to: self object size) - collectFields: [:pc | - (self newFieldForType: #bytecode key: pc) - valueGetter: [:compiledCode | compiledCode at: pc]; - flag: #dangerous; "mt: We might want to disallow inadvertent changes here..." - valueSetter: [:compiledCode :bytecode | compiledCode at: pc put: bytecode; voidCogVMState]; - yourself]! Item was removed: - ----- Method: CompiledCodeInspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- - streamIndexedVariablesOn: aStream - "Separate all indexed variables in literals and byte codes." - - self - streamLiteralsOn: aStream; - streamByteCodesOn: aStream.! Item was removed: - ----- Method: CompiledCodeInspector>>streamLiteralsOn: (in category 'fields - streaming') ----- - streamLiteralsOn: aStream - - self flag: #decompile. "mt: Use #to: and #do: instead of #to:do: to avoid inlining to preserve bindings in enumeration block for later decompilation. See InspectorField." - (1 to: self object numLiterals) do: [:index | - aStream nextPut: ((self newFieldForType: #literal key: index) - name: 'literal' , index; - valueGetter: [:compiledCode | compiledCode literalAt: index]; - flag: #dangerous; "mt: We might want to disallow inadvertent changes here..." - valueSetter: [:compiledCode :literal | compiledCode literalAt: index put: literal; voidCogVMState]; - yourself)].! Item was removed: - ----- Method: CompiledCodeInspector>>updateStyler:requestor: (in category 'user interface - styling') ----- - updateStyler: aStyler requestor: anObject - "Overridden to configure the styler to parse method source code correctly." - - | parseAMethod classOrMetaClass | - self selectedField - ifNil: [super updateStyler: aStyler requestor: anObject] - ifNotNil: [:field | - (anObject knownName = #valuePane and: [field type = #code]) - ifTrue: [parseAMethod := true. classOrMetaClass := self object methodClass] - ifFalse: [parseAMethod := false. classOrMetaClass := self doItReceiver class]. - - aStyler - environment: self environment; - classOrMetaClass: classOrMetaClass; - context: self doItContext; - parseAMethod: parseAMethod]. - - ! Item was added: + ----- Method: CompiledMethod>>inspectorClass (in category '*Tools-Inspector') ----- + inspectorClass + "Answer the class of the inspector to be used on the receiver. Called by inspect; + use basicInspect to get a normal (less useful) type of inspector." + + ^ CompiledMethodInspector! Item was added: + Inspector subclass: #CompiledMethodInspector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Inspector'! Item was added: + ----- Method: CompiledMethodInspector>>contentsIsString (in category 'selecting') ----- + contentsIsString + "Hacked so contents empty when deselected" + + ^ #(0 2 3) includes: selectionIndex! Item was added: + ----- Method: CompiledMethodInspector>>fieldList (in category 'accessing') ----- + fieldList + + | keys | + keys := OrderedCollection new. + keys add: 'self'. + keys add: 'all bytecodes'. + keys add: 'header'. + 1 to: object numLiterals do: [ :i | + keys add: 'literal', i printString ]. + object initialPC to: object size do: [ :i | + keys add: i printString ]. + ^ keys asArray + ! Item was added: + ----- Method: CompiledMethodInspector>>selection (in category 'selecting') ----- + selection + + | bytecodeIndex | + selectionIndex = 0 ifTrue: [^ '']. + selectionIndex = 1 ifTrue: [^ object ]. + selectionIndex = 2 ifTrue: [^ object symbolic]. + selectionIndex = 3 ifTrue: [^ object headerDescription]. + selectionIndex <= (object numLiterals + 3) + ifTrue: [ ^ object objectAt: selectionIndex - 2 ]. + bytecodeIndex := selectionIndex - object numLiterals - 3. + ^ object at: object initialPC + bytecodeIndex - 1! Item was added: + ----- Method: CompiledMethodInspector>>selectionUnmodifiable (in category 'selecting') ----- + selectionUnmodifiable + "Answer if the current selected variable is unmodifiable via acceptance in the code pane. For most inspectors, no selection and a selection of self (selectionIndex = 1) are unmodifiable" + + ^ true! Item was removed: - ----- Method: Context>>inspectorClass (in category '*Tools-Inspector') ----- - inspectorClass - - ^ ContextInspector! Item was changed: Inspector subclass: #ContextInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! - - !ContextInspector commentStamp: 'ct 1/12/2020 15:26' prior: 0! - I am an Inspector that is specialized for inspecting Contexts.! Item was added: + ----- Method: ContextInspector>>fieldList (in category 'accessing') ----- + fieldList + "Answer the base field list plus an abbreviated list of indices." + | tempNames stackIndices | + tempNames := object tempNames collect:[:t| '[',t,']']. + stackIndices := (object numTemps + 1 to: object stackPtr) collect: [:i| i printString]. + ^self baseFieldList, tempNames, stackIndices! Item was added: + ----- Method: ContextInspector>>selection (in category 'accessing') ----- + selection + "The receiver has a list of variables of its inspected object. + One of these is selected. Answer the value of the selected variable." + | basicIndex | + selectionIndex = 0 ifTrue: [^ '']. + selectionIndex = 1 ifTrue: [^ object]. + selectionIndex = 2 ifTrue: [^ object longPrintStringLimitedTo: 20000]. + selectionIndex - 2 <= object class instSize ifTrue: + [^object instVarAt: selectionIndex - 2]. + basicIndex := selectionIndex - 2 - object class instSize. + basicIndex <= object numTemps ifTrue: + [^object debuggerMap namedTempAt: basicIndex in: object]. + basicIndex <= object stackPtr ifTrue: + [^object at: basicIndex]. + ^nil + ! Item was removed: - ----- Method: ContextInspector>>streamFieldsOn: (in category 'fields - streaming') ----- - streamFieldsOn: aStream - - self object ifNil: [ - ^ self streamError: 'Cannot inspect a nil context' translated on: aStream]. - self object method ifNil: [ - ^ self streamError: 'Cannot inspect a context with nil method' translated on: aStream]. - - super streamFieldsOn: aStream.! Item was removed: - ----- Method: ContextInspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- - streamIndexedVariablesOn: aStream - "Just show (indexed) stack variables to the list." - - self streamStackVariablesOn: aStream.! Item was removed: - ----- Method: ContextInspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- - streamInstanceVariablesOn: aStream - "Add (named) temporary variables to the list." - - super streamInstanceVariablesOn: aStream. - self streamTemporaryVariablesOn: aStream.! Item was removed: - ----- Method: ContextInspector>>streamStackVariablesOn: (in category 'fields - streaming') ----- - streamStackVariablesOn: aStream - "If this context's stack pointer is not valid, silently skip streaming fields for stack variables. Do not stream an error field because freshly created or terminated contexts can be like this." - - self object stackPtr ifNil: [^ self]. - - self flag: #decompile. "mt: Use #to: and #do: instead of #to:do: to avoid inlining to preserve bindings in enumeration block for later decompilation. See InspectorField." - (self object numTemps + 1 to: self object stackPtr) do: [:index | - aStream nextPut: ((self newFieldForType: #stackItem key: index) - name: 'stack', index; deEmphasizeName; - valueGetter: [:object | object at: index]; - valueSetter: [:object :value | object at: index put: value]; - yourself)]! Item was removed: - ----- Method: ContextInspector>>streamTemporaryVariablesOn: (in category 'fields - streaming') ----- - streamTemporaryVariablesOn: aStream - - | tempNames | - tempNames := [self object tempNames] ifError: [ - ^ self streamError: 'Invalid temporaries' translated on: aStream]. - - tempNames doWithIndex: [:name :index | - aStream nextPut: ((self newFieldForType: #tempVar key: name) - name: ('[{1}]' format: {name}); - valueGetter: [:context | context namedTempAt: index]; - valueSetter: [:context :value | context namedTempAt: index put: value]; - yourself)]! Item was changed: + Inspector subclass: #ContextVariablesInspector + instanceVariableNames: 'fieldList' + classVariableNames: '' - ContextInspector subclass: #ContextVariablesInspector - instanceVariableNames: '' - classVariableNames: 'ShowStackVariables' poolDictionaries: '' category: 'Tools-Debugger'! + !ContextVariablesInspector commentStamp: 'eem 3/30/2017 17:32' prior: 0! + I represent a query path into the internal representation of a Context. Typically this is a context at a point in the query path of a Debugger. As a StringHolder, the string I represent is the value of the currently selected variable of the observed temporary variable of the context.! - !ContextVariablesInspector commentStamp: 'mt 3/25/2020 16:32' prior: 0! - I am an inspector that is specialized to inspecting the variables of a Context. I am typically displayed as part of a Debugger, where I sit besides an inspector for the receiver object. That's why a traditional Contextinspector would not work because it makes "ThisContext" be "self". - - At some point, this should subclass from Contextinspector.! Item was removed: - ----- Method: ContextVariablesInspector class>>showStackVariables (in category 'preferences') ----- - showStackVariables - <preference: 'Show stack variables in debugger' - category: #debug - description: 'When true, append the unnamed stack variables (if any) below the named temps in the debugger''s context inspector.' - type: #Boolean> - ^ ShowStackVariables ifNil: [false]! Item was removed: - ----- Method: ContextVariablesInspector class>>showStackVariables: (in category 'preferences') ----- - showStackVariables: aBoolean - - ShowStackVariables := aBoolean.! Item was added: + ----- Method: ContextVariablesInspector>>aboutToStyle:requestor: (in category 'styling') ----- + aboutToStyle: aStyler requestor: anObject + + (super aboutToStyle: aStyler requestor: anObject) + ifFalse: [^ false]. + aStyler + classOrMetaClass: self doItReceiver class; + context: self doItContext. + ^ true! Item was added: + ----- Method: ContextVariablesInspector>>contentsIsString (in category 'selecting') ----- + contentsIsString + "Hacked so contents empty when deselected and = long printString when item 3" + + ^ (selectionIndex = 3) | (selectionIndex = 0) | + (selectionIndex = 2 and: [object actualStackSize = 0])! Item was added: + ----- Method: ContextVariablesInspector>>defaultIntegerBase (in category 'selecting') ----- + defaultIntegerBase + "Answer the default base in which to print integers. + Defer to the class the code is compiled in." + ^[object method methodClass defaultIntegerBaseInDebugger] + on: MessageNotUnderstood + do: [:ex| 10]! Item was removed: - ----- Method: ContextVariablesInspector>>expressionForField: (in category 'private') ----- - expressionForField: anInspectorField - "Use #ThisContext instead of #self. Note the capital 'T' to not refer to the special keyword #thisContext, which would return the current execution context but not the one we are currently inspecting." - - ^ anInspectorField expressionWithReceiverName: #ThisContext! Item was removed: - ----- Method: ContextVariablesInspector>>fieldAllTempVars (in category 'fields') ----- - fieldAllTempVars - - ^ (self newFieldForType: #all key: #allTempVars) - name: 'all temp vars' translated; emphasizeName; - valueGetter: [:object | object tempsAndValues]; printValueAsIs; - yourself! Item was added: + ----- Method: ContextVariablesInspector>>fieldList (in category 'accessing') ----- + fieldList + "Refer to the comment in Inspector|fieldList." + + object == nil ifTrue: [^Array with: 'thisContext']. + ^fieldList ifNil:[fieldList := (Array with: 'thisContext' with: 'stack top' with: 'all temp vars') , object tempNames]! Item was removed: - ----- Method: ContextVariablesInspector>>fieldSelf (in category 'fields') ----- - fieldSelf - - ^ super fieldSelf - name: 'thisContext'; - yourself! Item was removed: - ----- Method: ContextVariablesInspector>>fieldStackTop (in category 'fields') ----- - fieldStackTop - "Note that #valueGetter returns the actual printString to not confuse an empty stack top with nil or an empty string. So the value pane will just stay empty if there is no stack top and it will show 'nil' or '''' otherwise." - - ^ (self newFieldForType: #stackTop key: #stackTop) - name: 'stack top' translated; emphasizeName; - valueGetter: [:context | context actualStackSize > 0 ifTrue: [context top printString] ifFalse: ['']]; - printValueAsIs; - valueGetterExpression: 'ThisContext top'; - yourself! Item was added: + ----- Method: ContextVariablesInspector>>inspect: (in category 'accessing') ----- + inspect: anObject + "Initialize the receiver so that it is inspecting anObject. There is no + current selection. + + Because no object's inspectorClass method answers this class, it is OK for this method to + override Inspector >> inspect: " + fieldList := nil. + object := anObject. + self initialize. + ! Item was added: + ----- Method: ContextVariablesInspector>>replaceSelectionValue: (in category 'selecting') ----- + replaceSelectionValue: anObject + "Refer to the comment in Inspector|replaceSelectionValue:." + + ^selectionIndex = 1 + ifTrue: [object] + ifFalse: [object namedTempAt: selectionIndex - 3 put: anObject]! Item was added: + ----- Method: ContextVariablesInspector>>selection (in category 'selecting') ----- + selection + "Refer to the comment in Inspector|selection." + ^selectionIndex + caseOf: { + [0] -> ['']. + [1] -> [object]. + [2] -> [object actualStackSize > 0 ifTrue: [object top] ifFalse: ['']]. + [3] -> [self tempsAndValues] } + otherwise: + [object debuggerMap namedTempAt: selectionIndex - 3 in: object]! Item was removed: - ----- Method: ContextVariablesInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- - streamBaseFieldsOn: aStream - - self object ifNil: [^ self]. - aStream - nextPut: self fieldSelf; - nextPut: self fieldStackTop; - nextPut: self fieldAllTempVars.! Item was removed: - ----- Method: ContextVariablesInspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- - streamIndexedVariablesOn: aStream - - self class showStackVariables ifTrue: [ - self streamStackVariablesOn: aStream].! Item was removed: - ----- Method: ContextVariablesInspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- - streamInstanceVariablesOn: aStream - "Just show the (named) temporary variables to the list. Hide internals. The receiver is in the debugger's companion inspector." - - self streamTemporaryVariablesOn: aStream.! Item was removed: - ----- Method: ContextVariablesInspector>>streamTemporaryVariablesOn: (in category 'fields - streaming') ----- - streamTemporaryVariablesOn: aStream - "Overwritten to change the visuals of temps in debuggers." - - | tempNames | - tempNames := [self object tempNames] ifError: [ - ^ self streamError: 'Invalid temporaries' translated on: aStream]. - - tempNames doWithIndex: [:name :index | - aStream nextPut: ((self newFieldForType: #tempVar key: name) - shouldStyleName: true; - valueGetter: [:context | context namedTempAt: index]; - valueSetter: [:context :value | context namedTempAt: index put: value]; - yourself)].! Item was added: + ----- Method: ContextVariablesInspector>>tempsAndValues (in category 'selecting') ----- + tempsAndValues + "Answer a string of the temporary variables and their current values" + | debuggerMap integerClasses aStream | + aStream := WriteStream on: (String new: 100). + debuggerMap := object debuggerMap. + integerClasses := Integer allSubclasses. + (debuggerMap tempNamesForContext: object) doWithIndex: + [:title :index | | temp | + aStream nextPutAll: title; nextPut: $:; space; tab. + temp := debuggerMap namedTempAt: index in: object. + (integerClasses identityIndexOf: (object objectClass: temp)) ~= 0 + ifTrue: [temp storeOn: aStream base: self defaultIntegerBase] + ifFalse: [object print: temp on: aStream]. + aStream cr]. + ^aStream contents! Item was removed: - ----- Method: Debugger>>browseClassHierarchy (in category 'toolbuilder') ----- - browseClassHierarchy - "Create and schedule a class list browser on the receiver's hierarchy." - - (self selectedMessageName = #doesNotUnderstand: and: [ self selectedClassOrMetaClass = Object ]) - ifTrue: - [ self systemNavigation - spawnHierarchyForClass: self receiverClass - selector: self selectedMessageName ] - ifFalse: [ super browseClassHierarchy ]! Item was added: + ----- Method: Debugger>>classHierarchy (in category 'toolbuilder') ----- + classHierarchy + "Create and schedule a class list browser on the receiver's hierarchy." + (self selectedMessageName = #doesNotUnderstand: and: [ self selectedClassOrMetaClass = Object ]) + ifTrue: + [ self systemNavigation + spawnHierarchyForClass: self receiverClass + selector: self selectedMessageName ] + ifFalse: [ super classHierarchy ]! Item was changed: ----- Method: Debugger>>contextStackIndex:oldContextWas: (in category 'private') ----- contextStackIndex: anInteger oldContextWas: oldContext "Change the context stack index to anInteger, perhaps in response to user selection." + | isNewMethod selectedContextSlotName | - | isNewMethod | self saveReceiverInspectorState. self saveContextVariablesInspectorState. contextStackIndex := anInteger. anInteger = 0 ifTrue: [currentCompiledMethod := contents := nil. self changed: #contextStackIndex. self decorateButtons. self contentsChanged. contextVariablesInspector object: nil. + receiverInspector object: self receiver. - receiverInspector context: nil; inspect: self receiver. ^self]. + selectedContextSlotName := contextVariablesInspector selectedFieldName. + isNewMethod := oldContext == nil + or: [oldContext method ~~ (currentCompiledMethod := self selectedContext method)]. - isNewMethod := oldContext isNil - or: [oldContext method ~~ (currentCompiledMethod := self selectedContext method)]. isNewMethod ifTrue: [contents := self selectedMessage. self contentsChanged. self pcRange]. self changed: #contextStackIndex. self decorateButtons. contextVariablesInspector object: self selectedContext. self restoreContextVariablesInspectorState. + receiverInspector object: self receiver. - receiverInspector context: self selectedContext; inspect: self receiver. self restoreReceiverInspectorState. isNewMethod ifFalse: [self changed: #contentsSelection]! Item was changed: ----- Method: Debugger>>initializeFull (in category 'initialize') ----- initializeFull "Expand the stack for the full debugger. Create inspectors." | oldIndex | oldIndex := contextStackIndex. contextStackIndex := 0. self expandStack. + receiverInspector := Inspector inspect: nil. + contextVariablesInspector := ContextVariablesInspector inspect: nil. - receiverInspector := Inspector on: nil. - contextVariablesInspector := ContextVariablesInspector on: nil. self toggleContextStackIndex: oldIndex.! Item was changed: ----- Method: Debugger>>newStack: (in category 'private') ----- newStack: stack | oldStack diff | oldStack := contextStack. contextStack := stack. (oldStack == nil or: [oldStack last ~~ stack last]) ifTrue: [contextStackList := contextStack collect: [:ctx | ctx printString]. ^ self]. "May be able to re-use some of previous list" diff := stack size - oldStack size. contextStackList := diff <= 0 ifTrue: [contextStackList copyFrom: 1-diff to: oldStack size] + ifFalse: [diff > 1 + ifTrue: [contextStack collect: [:ctx | ctx printString]] + ifFalse: [(Array with: stack first printString) , contextStackList]]! - ifFalse: [(diff = 1 and: [stack second == oldStack first]) - ifTrue: [contextStackList copyWithFirst: stack first printString] - ifFalse: [contextStack collect: [:ctx | ctx printString]]]! Item was added: + ----- Method: Debugger>>receiverInspectorObject:context: (in category 'accessing') ----- + receiverInspectorObject: obj context: ctxt + + "set context before object so it can refer to context when building field list" + receiverInspector context: ctxt. + receiverInspector object: obj. + ! Item was changed: ----- Method: Debugger>>saveContextVariablesInspectorState (in category 'user interface') ----- saveContextVariablesInspectorState "For the user's convenience. Save field selection and user-typed content in the context-variables inspector. See #restoreContextVariablesInspectorState." | stateToSave keyForState | - self flag: #duplication. (keyForState := self keyForContextVariablesInspectorState) ifNil: [^ self]. contextVariablesInspectorState ifNil: [contextVariablesInspectorState := IdentityDictionary new]. stateToSave := { self contextVariablesInspector selectedFieldName. self contextVariablesInspector contentsTyped }. contextVariablesInspectorState at: keyForState put: stateToSave.! Item was changed: ----- Method: Debugger>>saveReceiverInspectorState (in category 'user interface') ----- saveReceiverInspectorState "For the user's convenience. Save field selection and user-typed content in the receiver inspector. See #restoreReceiverInspectorState." | stateToSave keyForState | - self flag: #duplication. (keyForState := self keyForReceiverInspectorState) ifNil: [^ self]. receiverInspectorState ifNil: [receiverInspectorState := IdentityDictionary new]. stateToSave := { self receiverInspector selectedFieldName. self receiverInspector contentsTyped }. receiverInspectorState at: keyForState put: stateToSave.! Item was changed: ----- Method: Debugger>>shiftedContextStackMenu: (in category 'context stack menu') ----- shiftedContextStackMenu: aMenu "Set up the menu appropriately for the context-stack-list, shifted" <contextStackMenuShifted: true> ^ aMenu addList: #( + ('browse class hierarchy' classHierarchy) - ('browse class hierarchy' browseClassHierarchy) ('browse class' browseClass) ('implementors of sent messages' browseAllMessages) ('change sets with this method' findMethodInChangeSets) - ('inspect instances' inspectInstances) ('inspect subinstances' inspectSubInstances) - ('revert to previous version' revertToPreviousVersion) ('remove from current change set' removeFromCurrentChanges) ('revert & remove from changes' revertAndForget)); yourself ! Item was changed: ----- Method: DependencyBrowser>>computePackageDependencies: (in category 'package deps') ----- computePackageDependencies: pkgName "Compute the dependencies for the given package" | pi | classDeps := Dictionary new. packageDeps := Dictionary new. pkgName ifNil:[^self]. pi := PackageOrganizer default packageNamed: pkgName ifAbsent:[^self]. "unloaded" pi classes do:[:pkgClass| (classDeps at: (pkgClass superclass ifNil:[ProtoObject]) name ifAbsentPut:[OrderedCollection new]) add: (MethodReference class: pkgClass selector: #Definition)]. pi methods do:[:mref| mref compiledMethod allLiteralsDo:[:lit | (lit isVariableBinding and: [lit value isBehavior]) ifTrue:[ (classDeps at: lit value name ifAbsentPut:[OrderedCollection new]) add: mref]]]. classDeps keys do:[:className| | aClass pkg | aClass := Smalltalk classNamed: className. pkg := aClass ifNil: [nil] ifNotNil: [PackageOrganizer default packageOfClass: aClass ifNone:[nil]]. pkg ifNil:[ Transcript cr; show: 'WARNING: No package for ', className. (classDeps removeKey: className) do:[:each| Transcript crtab; show: each]. ] ifNotNil:[ (packageDeps at: pkg name ifAbsentPut:[OrderedCollection new]) add: className. ]. ]. (packageDeps removeKey: pkgName ifAbsent:[#()]) do:[:each| classDeps removeKey: each ifAbsent:[]. ].! Item was changed: + Inspector subclass: #DictionaryInspector + instanceVariableNames: 'keyArray' - CollectionInspector subclass: #DictionaryInspector - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! - - !DictionaryInspector commentStamp: 'ct 1/12/2020 15:26' prior: 0! - I am an Inspector that is specialized for inspecting Dictionarys.! Item was removed: - ----- Method: DictionaryInspector>>addElement (in category 'menu - commands') ----- - addElement - - self addElement: (self requestKeyOrCancel: [^ self]).! Item was removed: - ----- Method: DictionaryInspector>>addElement: (in category 'menu - commands') ----- - addElement: aKey - - self object at: aKey put: nil. - self updateFields. - - self selectKey: aKey. - self hasSelection ifFalse: [self inform: ('The new key {1} was added.\\Yet, the list of fields is quite long. The new field\got truncated and is thus not visible.' translated withCRs format: {aKey printString})].! Item was added: + ----- Method: DictionaryInspector>>addEntry (in category 'menu') ----- + addEntry + | newKey aKey | + + newKey := UIManager default request: + 'Enter new key, then type RETURN. + (Expression will be evaluated for value.) + Examples: #Fred ''a string'' 3+4'. + aKey := Compiler evaluate: newKey. + object at: aKey put: nil. + self calculateKeyArray. + selectionIndex := self numberOfFixedFields + (keyArray indexOf: aKey). + self changed: #inspectObject. + self changed: #selectionIndex. + self changed: #fieldList. + self update! Item was added: + ----- Method: DictionaryInspector>>addEntry: (in category 'selecting') ----- + addEntry: aKey + object at: aKey put: nil. + self calculateKeyArray. + selectionIndex := self numberOfFixedFields + (keyArray indexOf: aKey). + self changed: #inspectObject. + self changed: #selectionIndex. + self changed: #fieldList. + self update! Item was removed: - ----- Method: DictionaryInspector>>addFieldItemsTo: (in category 'menu - construction') ----- - addFieldItemsTo: aMenu - - super addFieldItemsTo: aMenu. - - self typeOfSelection = #element ifFalse: [^ self]. - - aMenu addLine. - - self selectedKey isSymbol ifTrue: [ - aMenu addTranslatedList: #( - ('senders of this key' sendersOfSelectedKey))]. - - aMenu addTranslatedList: #( - ('inspect key' inspectKey) - ('rename key' renameKey)). - - self isBindingSelected ifTrue: [ - aMenu addTranslatedList: #( - - - ('references to binding' usersOfSelectedBinding 'Browse all users of this binding.'))].! Item was added: + ----- Method: DictionaryInspector>>calculateKeyArray (in category 'selecting') ----- + calculateKeyArray + "Recalculate the KeyArray from the object being inspected." + keyArray := [ object keysInOrder ] ifError: + [ "Can occur when debugging Dictionary new" + Array empty ]. + selectionIndex := 0! Item was removed: - ----- Method: DictionaryInspector>>canAddOrRemoveElements (in category 'private') ----- - canAddOrRemoveElements - "Due to a strange reason, #add: is supported in Dictionary but #remove:ifAbsent: is not." - - ^ true! Item was added: + ----- Method: DictionaryInspector>>contentsIsString (in category 'selecting') ----- + contentsIsString + "Hacked so contents empty when deselected" + + ^ (selectionIndex = 0)! Item was added: + ----- Method: DictionaryInspector>>copyName (in category 'menu') ----- + copyName + "Copy the name of the current variable, so the user can paste it into the + window below and work with is. If collection, do (xxx at: 1)." + | sel | + self selectionIndex <= self numberOfFixedFields + ifTrue: [super copyName] + ifFalse: [sel := String streamContents: [:strm | + strm nextPutAll: '(self at: '. + (keyArray at: selectionIndex - self numberOfFixedFields) + storeOn: strm. + strm nextPutAll: ')']. + Clipboard clipboardText: sel asText "no undo allowed"]! Item was removed: - ----- Method: DictionaryInspector>>elementIndices (in category 'private') ----- - elementIndices - - ^ [ self object keysInOrder ] ifError: [ - "Can occur when debugging Dictionary new" - Array empty]! Item was added: + ----- Method: DictionaryInspector>>fieldList (in category 'accessing') ----- + fieldList + ^ self baseFieldList + , (keyArray collect: [:key | key printString])! Item was added: + ----- Method: DictionaryInspector>>initialize (in category 'initialize-release') ----- + initialize + super initialize. + self calculateKeyArray! Item was changed: + ----- Method: DictionaryInspector>>inspectKey (in category 'menu commands') ----- - ----- Method: DictionaryInspector>>inspectKey (in category 'menu - commands') ----- inspectKey "Create and schedule an Inspector on the receiver's model's currently selected key." + selectionIndex >= self numberOfFixedFields ifTrue: + [(keyArray at: selectionIndex - self numberOfFixedFields) inspect]! - self assertElementSelectedOr: [^ self]. - self selectedKey inspect.! Item was removed: - ----- Method: DictionaryInspector>>isBindingSelected (in category 'bindings') ----- - isBindingSelected - "Whether the currently selection association is a binding to a class or global." - - ^ self selectedKey ifNil: [false] ifNotNil: [:key | - (self object associationAt: key) isKindOf: Binding]! Item was added: + ----- Method: DictionaryInspector>>mainFieldListMenu: (in category 'menu') ----- + mainFieldListMenu: aMenu + + ^ aMenu addList: #( + ('inspect' inspectSelection) + ('inspect key' inspectKey) + ('copy name' copyName) + ('references' selectionReferences) + ('objects pointing to this value' objectReferencesToSelection) + ('senders of this key' sendersOfSelectedKey) + - + ('refresh view' refreshView) + ('add key' addEntry) + ('rename key' renameEntry) + - + ('remove' removeSelection) + ('basic inspect' inspectBasic)); + yourself + ! Item was added: + ----- Method: DictionaryInspector>>numberOfFixedFields (in category 'private') ----- + numberOfFixedFields + ^ 2 + object class instSize! Item was added: + ----- Method: DictionaryInspector>>refreshView (in category 'selecting') ----- + refreshView + | i | + i := selectionIndex. + self calculateKeyArray. + selectionIndex := i. + self changed: #fieldList. + self changed: #contents.! Item was removed: - ----- Method: DictionaryInspector>>removeSelectedElement (in category 'menu - commands') ----- - removeSelectedElement - - self object removeKey: self selectedKey.! Item was added: + ----- Method: DictionaryInspector>>removeSelection (in category 'menu') ----- + removeSelection + selectionIndex = 0 ifTrue: [^ self changed: #flash]. + object removeKey: (keyArray at: selectionIndex - self numberOfFixedFields). + selectionIndex := 0. + self setContents: ''. + self calculateKeyArray. + self changed: #inspectObject. + self changed: #selectionIndex. + self changed: #fieldList. + self changed: #selection.! Item was added: + ----- Method: DictionaryInspector>>renameEntry (in category 'menu') ----- + renameEntry + | newKey aKey value | + + value := object at: (keyArray at: selectionIndex - self numberOfFixedFields). + newKey := UIManager default request: + 'Enter new key, then type RETURN. + (Expression will be evaluated for value.) + Examples: #Fred ''a string'' 3+4' + initialAnswer: (keyArray at: selectionIndex - self numberOfFixedFields) printString. + aKey := Compiler evaluate: newKey. + object removeKey: (keyArray at: selectionIndex - self numberOfFixedFields). + object at: aKey put: value. + self calculateKeyArray. + selectionIndex := self numberOfFixedFields + (keyArray indexOf: aKey). + self changed: #selectionIndex. + self changed: #inspectObject. + self changed: #fieldList. + self update! Item was removed: - ----- Method: DictionaryInspector>>renameKey (in category 'menu - commands') ----- - renameKey - - self assertElementSelectedOr: [^ self changed: #flash]. - self renameKey: ( - self - requestKeyInitialAnswer: self selectedKey storeString - orCancel: [^ self]).! Item was removed: - ----- Method: DictionaryInspector>>renameKey: (in category 'menu - commands') ----- - renameKey: aKey - - self assertElementSelectedOr: [^ self changed: #flash]. - - (self object includesKey: aKey) - ifTrue: [(self confirm: 'The target key exists. Do you want to replace it?' translated) - ifFalse: [^ self]]. - - self object - at: aKey put: self selection; - removeKey: self selectedKey. - self updateFields. - - self selectKey: aKey. - self hasSelection ifFalse: [self inform: ('The selected key was renamed to {1}.\\Yet, the list of fields is quite long. The new field\got truncated and is thus not visible.' translated withCRs format: {aKey printString})].! Item was added: + ----- Method: DictionaryInspector>>replaceSelectionValue: (in category 'selecting') ----- + replaceSelectionValue: anObject + selectionIndex <= self numberOfFixedFields + ifTrue: [^ super replaceSelectionValue: anObject]. + ^ object + at: (keyArray at: selectionIndex - self numberOfFixedFields) + put: anObject! Item was removed: - ----- Method: DictionaryInspector>>requestKeyInitialAnswer:orCancel: (in category 'ui requests') ----- - requestKeyInitialAnswer: anAnswerString orCancel: aBlock - - ^ self - requestObject: ('Enter an expression for the new key\such as #tree, ''apple'', and 3+4.' translated withCRs) - initialAnswer: anAnswerString - orCancel: aBlock! Item was removed: - ----- Method: DictionaryInspector>>requestKeyOrCancel: (in category 'ui requests') ----- - requestKeyOrCancel: aBlock - - ^ self - requestKeyInitialAnswer: String empty - orCancel: aBlock! Item was removed: - ----- Method: DictionaryInspector>>selectKey: (in category 'selection') ----- - selectKey: aKey - "Overriden to make clear that a dictionary's indices are called 'keys'." - - self selectElementAt: aKey.! Item was removed: - ----- Method: DictionaryInspector>>selectedBinding (in category 'bindings') ----- - selectedBinding - - ^ self selectedKey - ifNotNil: [:key | self object associationAt: key]! Item was removed: - ----- Method: DictionaryInspector>>selectedKey (in category 'selection') ----- - selectedKey - "Overriden to make clear that a dictionary's indices are called 'keys'." - - ^ self selectedElementIndex! Item was added: + ----- Method: DictionaryInspector>>selection (in category 'selecting') ----- + selection + + selectionIndex <= (self numberOfFixedFields) ifTrue: [^ super selection]. + ^ object at: (keyArray at: selectionIndex - self numberOfFixedFields) ifAbsent:[nil]! Item was added: + ----- Method: DictionaryInspector>>selectionReferences (in category 'menu') ----- + selectionReferences + "Create a browser on all references to the association of the current selection." + + self selectionIndex <= self numberOfFixedFields ifTrue: [^ self changed: #flash]. + object class == MethodDictionary ifTrue: [^ self changed: #flash]. + self systemNavigation browseAllCallsOn: (object associationAt: (keyArray at: selectionIndex - self numberOfFixedFields))! Item was changed: + ----- Method: DictionaryInspector>>sendersOfSelectedKey (in category 'menu') ----- - ----- Method: DictionaryInspector>>sendersOfSelectedKey (in category 'menu - commands') ----- sendersOfSelectedKey "Create a browser on all senders of the selected key" - | aKey | + self selectionIndex = 0 + ifTrue: [^ self changed: #flash]. + ((aKey := keyArray at: selectionIndex - self numberOfFixedFields) isSymbol) - ((aKey := self selectedKey) isSymbol) ifFalse: [^ self changed: #flash]. + SystemNavigation default browseAllCallsOn: aKey! - self systemNavigation browseAllCallsOn: aKey! Item was removed: - ----- Method: DictionaryInspector>>usersOfSelectedBinding (in category 'menu - commands') ----- - usersOfSelectedBinding - "Create a browser on all references to the association of the current selection." - - self selectedBinding ifNotNil: [:binding | - self systemNavigation browseAllCallsOn: binding].! Item was changed: ----- Method: FileList>>readGraphicContents (in category 'private') ----- readGraphicContents | form maxExtent ext | + form := Form fromFileNamed: self fullName. - form := (Form fromFileNamed: self fullName) asFormOfDepth: Display depth. maxExtent := lastGraphicsExtent := self availableGraphicsExtent. ext := form extent. (maxExtent notNil and: [form extent <= maxExtent]) ifFalse: [ form := form magnify: form boundingBox by: (maxExtent x / form width min: maxExtent y / form height) asPoint smoothing: 3]. contents := ('Image extent: ', ext printString) asText, (String with: Character cr), (Text string: ' ' attribute: (TextFontReference toFont: (FormSetFont new fromFormArray: (Array with: form) asciiStart: Character space asInteger ascent: form height))). brevityState := #graphic. ^contents! Item was changed: ----- Method: FileList2 class>>endingSpecs (in category 'blue ui') ----- endingSpecs "Answer a collection of specs to build the selective 'find anything' tool called by the Navigator. This version uses the services registry to do so." + "FileList2 morphicViewGeneralLoaderInWorld: World" + | categories specs rejects | - "FileList2 morphicViewGeneralLoaderInWorld: Project current world" - | specs rejects | rejects := #(addFileToNewZip: compressFile: openInZipViewer: extractAllFrom: openOn:). + categories := #( + ('Art' ('bmp' 'gif' 'jpg' 'jpeg' 'form' 'png' 'pcx' 'xbm' 'xpm' 'ppm' 'pbm')) + ('Morphs' ('morph' 'morphs' 'sp')) + ('Projects' ('extseg' 'project' 'pr')) + ('MIDI' ('mid' 'midi')) + ('Music' ('mp3')) + ('Movies' ('movie' 'mpg' 'mpeg' 'qt' 'mov')) + ('Flash' ('swf')) + ). + + "('Books' ('bo'))" + "('Code' ('st' 'cs'))" + "('TrueType' ('ttf'))" + "('3ds' ('3ds'))" + "('Tape' ('tape'))" + "('Wonderland' ('wrl'))" + "('HTML' ('htm' 'html'))" + + categories first at: 2 put: ImageReadWriter allTypicalFileExtensions. specs := OrderedCollection new. + categories do: [ :cat | | catSpecs catServices okExtensions services | - self fileExtensionsByCategory keysAndValuesDo: [:category :extensions | - | services okExtensions | services := Dictionary new. + catSpecs := Array new: 3. + catServices := OrderedCollection new. okExtensions := Set new. + + cat second do: [ :ext | (FileServices itemsForFile: (FileDirectory default fullPathFor: ('fred.',ext))) do: [ :i | + (rejects includes: i selector) ifFalse: [ + okExtensions add: ext. + services at: i label put: i ]]]. + services do: [ :svc | catServices add: svc ]. - - extensions do: [:ext | - (FileServices itemsForFile: (FileDirectory default fullPathFor: 'fred.' , ext)) - reject: [:service | rejects includes: service selector] - thenDo: [:service | - services at: service label put: service. - okExtensions add: ext]]. services isEmpty ifFalse: [ + catSpecs at: 1 put: cat first; + at: 2 put: okExtensions; + at: 3 put: catServices. + specs add: catSpecs ] + ]. + ^specs + ! - specs add: { - category. - okExtensions. - services values }]]. - ^ specs! Item was removed: - ----- Method: FileList2 class>>fileExtensionsByCategory (in category 'blue ui') ----- - fileExtensionsByCategory - - ^ OrderedDictionary new - at: 'Art' put: ImageReadWriter allTypicalFileExtensions; - at: 'Morphs' put: #('morph' 'morphs' 'sp'); - at: 'Projects' put: #('extseg' 'project' 'pr'); - at: 'MIDI' put: #('mid' 'midi'); - at: 'Music' put: #('mp3'); - at: 'Movies' put: #('movie' 'mpg' 'mpeg' 'qt' 'mov'); - at: 'Flash' put: #('swf'); - "at: 'Books' put: #('bo'); - at: 'Code' put: #('st' 'cs'); - at: 'TrueType' put: #('ttf'); - at: '3ds' put: #('3ds'); - at: 'Tape' put: #('tape'); - at: 'Wonderland' put: #('wrl'); - at: 'HTML' put: #('htm' 'html');" - yourself! Item was changed: ----- Method: FileList2 class>>update:in:fileTypeRow:morphUp: (in category 'morphic ui') ----- update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph | fileTypeInfo info2 buttons textColor1 fileSuffixes fileActions aFileList fileTypeString | + + (morph notNil and:[(morph valueOfProperty: #enabled) not]) ifTrue: [^self]. + fileTypeRow submorphsDo: [ :sub | - (morph notNil and: [(morph valueOfProperty: #enabled) not]) ifTrue: [^ self]. - - fileTypeRow submorphsDo: [:sub | sub color: ( sub == morph ifTrue: [Color white] ifFalse: [(sub valueOfProperty: #enabled) + ifTrue: [Color transparent] ifFalse: [Color gray]] + ). + ]. + fileTypeString := morph isNil ifTrue:['xxxx'] ifFalse:[morph valueOfProperty: #buttonText]. + - ifTrue: [Color transparent] - ifFalse: [Color gray]])]. - fileTypeString := morph isNil - ifTrue: ['xxxx'] - ifFalse: [morph valueOfProperty: #buttonText]. - aFileList := window valueOfProperty: #FileList. textColor1 := Color r: 0.742 g: 0.839 b: 1.0. actionRow removeAllMorphs. fileTypeInfo := self endingSpecs. + info2 := fileTypeInfo detect: [ :each | each first = fileTypeString] ifNone: [ nil ]. + info2 isNil + ifTrue:[ + buttons := OrderedCollection new + ] + ifFalse:[ - info2 := fileTypeInfo - detect: [:each | each first = fileTypeString] - ifNone: [nil]. - info2 - ifNil: [ - buttons := OrderedCollection new] - ifNotNil: [ fileSuffixes := info2 second. fileActions := info2 third. + buttons := fileActions collect: [ :each | aFileList blueButtonForService: each textColor: textColor1 inWindow: window ]. - buttons := fileActions - collect: [ :each | aFileList blueButtonForService: each textColor: textColor1 inWindow: window ] - as: OrderedCollection. buttons do: [ :each | + each fillWithRamp: Color lightGreen oriented: (0.75 @ 0). + ]. + ]. - each fillWithRamp: Color lightGreen oriented: (0.75 @ 0)]]. buttons addLast: (self + blueButtonText: 'Cancel' + textColor: textColor1 + color: Color lightRed + inWindow: window + balloonText: 'Cancel this search' selector: #cancelHit recipient: aFileList). + buttons do: [ :each | actionRow addMorphBack: each]. - blueButtonText: 'Cancel' - textColor: textColor1 - color: Color lightRed - inWindow: window - balloonText: 'Cancel this search' - selector: #cancelHit - recipient: aFileList). - buttons do: [:each | actionRow addMorphBack: each]. window fullBounds. + fileSuffixes isNil ifFalse:[ - fileSuffixes ifNotNil: [ aFileList fileSelectionBlock: ( + self selectionBlockForSuffixes: (fileSuffixes collect: [ :each | '*.',each]) + ). + ]. - self selectionBlockForSuffixes: (fileSuffixes collect: [ :each | '*.',each]))]. aFileList updateFileList.! Item was added: + ----- Method: FloatArray>>inspectorClass (in category '*Tools-Inspector') ----- + inspectorClass + "Answer the class of the inspector to be used on the receiver. Called by inspect; + use basicInspect to get a normal (less useful) type of inspector." + + ^OrderedCollectionInspector! Item was changed: + ----- Method: FutureMaker>>defaultLabelForInspector (in category '*Tools-inspecting') ----- - ----- Method: FutureMaker>>defaultLabelForInspector (in category '*Tools-Inspector') ----- defaultLabelForInspector "Answer the default label to be used for an Inspector window on the receiver." ^self class name! Item was changed: + ----- Method: FutureMaker>>inspectorClass (in category '*Tools-inspecting') ----- - ----- Method: FutureMaker>>inspectorClass (in category '*Tools-Inspector') ----- inspectorClass "Answer the class of the inspector to be used on the receiver. Called by inspect; use basicInspect to get a normal (less useful) type of inspector." ^ Inspector! Item was changed: StringHolder subclass: #Inspector + instanceVariableNames: 'object selectionIndex timeOfLastListUpdate selectionUpdateTime context expression shouldStyleValuePane contentsTyped' - instanceVariableNames: 'object context fields customFields selectionIndex expression contentsTyped fieldListStyler shouldStyleValuePane selectionUpdateTime' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! + !Inspector commentStamp: '<historical>' prior: 0! + I represent a query path into the internal representation of an object. As a StringHolder, the string I represent is the value of the currently selected variable of the observed object.! - !Inspector commentStamp: 'mt 4/6/2020 15:16' prior: 0! - I am a tool that allows to inspect and modify the internal representation of an object. As a StringHolder, the string I represent is the value of the currently selected inspector field, which may be an instance variable, of the observed object. - - Beside the #contents in my value pane, I have an extra code pane that holds an #expression to be evaluated on the inspected object -- not the currently selected inspector field. - - Take a look at my "fields ..." protocols as well as InspectorField. - - (Note that the idea of "elements" from the CollectionInspector bleeds a little bit down into this interface to simplify the implementation of field truncation as well as #inspectOne. Sorry for that. Usually, the inspected object will only produce "fields" to display, and maybe "items" in a pop-up menu. Only collections have "elements".)! Item was changed: ----- Method: Inspector class>>inspect: (in category 'instance creation') ----- inspect: anObject + "Answer an instance of me to provide an inspector for anObject." + + "We call basicNew to avoid a premature initialization; the instance method + inspect: anObject will do a self initialize." - "Answer a new (sub)instance of me to provide an inspector for anObject." + ^self basicNew inspect: anObject! - ^ self new inspect: anObject! Item was removed: - ----- Method: Inspector class>>on: (in category 'instance creation') ----- - on: anObject - "Answer a new instance of me to provide an inspector for anObject." - - ^ self new object: anObject! Item was changed: ----- Method: Inspector class>>openOn: (in category 'instance creation') ----- openOn: anObject + "Create and schedule an instance of me on the model, anInspector. " + + ^ self openOn: anObject withLabel: anObject defaultLabelForInspector! - "Open an inspector for anObject." - - ^ ToolBuilder open: (self on: anObject)! Item was changed: ----- Method: Inspector class>>openOn:withLabel: (in category 'instance creation') ----- openOn: anObject withLabel: label - "Open an inspector with a specific label. Use this to set the inspector into context to explain why that object is inspected." + ^ ToolBuilder open: (self inspect: anObject) label: label! - ^ ToolBuilder open: (self on: anObject) label: label! Item was changed: + ----- Method: Inspector>>aboutToStyle:requestor: (in category 'styling') ----- - ----- Method: Inspector>>aboutToStyle:requestor: (in category 'user interface - styling') ----- aboutToStyle: aStyler requestor: anObject + + (anObject knownName = #valuePane and: [shouldStyleValuePane not]) + ifTrue: [^ false]. - "We have two text fields in this tool: code pane and value pane. Do always style the code pane." + aStyler + classOrMetaClass: object class; + parseAMethod: false. + ^true! - self updateStyler: aStyler requestor: anObject. - - ^ (anObject knownName = #valuePane) - ==> [shouldStyleValuePane == true - "Fields can override styling so that contents are always styled." - or: [self selectedField notNil ==> [self selectedField shouldStyleValue]]]! Item was added: + ----- Method: Inspector>>accept: (in category 'selecting') ----- + accept: aString + | result | + result := self doItReceiver class evaluatorClass new + evaluate: (ReadStream on: aString) + in: self doItContext + to: self doItReceiver + notifying: nil "fix this" + ifFail: [self changed: #flash. + ^ false]. + self replaceSelectionValue: result. + self changed: #contents. + ^ true! Item was removed: - ----- Method: Inspector>>addClassItemsTo: (in category 'menu - construction') ----- - addClassItemsTo: aMenu - - aMenu addTranslatedList: #( - - - ('browse full (b)' browseClass) - ('browse hierarchy (h)' browseClassHierarchy) - ('browse protocol (p)' browseFullProtocol)). - - self typeOfSelection = #self ifFalse: [^ self]. - - aMenu addTranslatedList: #( - - - ('references... (r)' browseVariableReferences) - ('assignments... (a)' browseVariableAssignments) - ('class refs (N)' browseClassRefs)).! Item was changed: + ----- Method: Inspector>>addCollectionItemsTo: (in category 'menu commands') ----- - ----- Method: Inspector>>addCollectionItemsTo: (in category 'menu - construction') ----- addCollectionItemsTo: aMenu + "If the current selection is an appropriate collection, add items to aMenu that cater to that kind of selection" + | sel | + ((((sel := self selection) isMemberOf: Array) or: [sel isMemberOf: OrderedCollection]) and: + [sel size > 0]) ifTrue: [ + aMenu addList: #( + ('inspect element...' inspectElement))]. + + (sel respondsTo: #inspectElement) ifTrue: [ + aMenu addList: #( + ('inspect property...' inspectElement))].! - aMenu - add: 'inspect element...' translated - target: self - selector: #inspectOne.! Item was removed: - ----- Method: Inspector>>addCustomField (in category 'fields - custom') ----- - addCustomField - - ^ self addCustomField: (self requestCustomFieldOrCancel: [^ self])! Item was removed: - ----- Method: Inspector>>addCustomField: (in category 'fields - custom') ----- - addCustomField: aField - - aField type: #custom. - self customFields add: aField. - self updateFields. - self selectField: aField.! Item was removed: - ----- Method: Inspector>>addEtoysItemsTo: (in category 'menu - construction') ----- - addEtoysItemsTo: aMenu - - aMenu addLine; addTranslatedList: { - { 'tile for this value (t)'. [self selectionOrObject tearOffTile] }. - { 'viewer for this value (v)'. [self selectionOrObject beViewed] }}.! Item was removed: - ----- Method: Inspector>>addFieldItemsTo: (in category 'menu - construction') ----- - addFieldItemsTo: aMenu - - aMenu addTranslatedList: #( - - - ('copy name (c)' copyName) - ('copy expression' copyExpression 'Copy a code snippet that returns the field''s value when evaluated on the inspected object.')).! Item was removed: - ----- Method: Inspector>>addInstVarItemsTo: (in category 'menu - construction') ----- - addInstVarItemsTo: aMenu - - aMenu addTranslatedList: #( - - - ('references (r)' browseVariableReferences) - ('assignments (a)' browseVariableAssignments)).! Item was removed: - ----- Method: Inspector>>addObjectItemsTo: (in category 'menu - construction') ----- - addObjectItemsTo: aMenu - "The following menu items trigger actions appropricate to all kinds of objects." - - self typeOfSelection = #ellipsis ifTrue: [^ self]. - - aMenu addTranslatedList: { - {'inspect (i)'. #inspectSelection}. - {'explore (I)'. #exploreSelection}. - {'basic inspect'. #inspectSelectionBasic. - 'Inspect all instvars of the object, regardless of\any possible specialized Inspector for this type' withCRs}}. - - aMenu addTranslatedList: { - #-. - {'inspect pointers'. #objectReferencesToSelection. 'objects pointing to this value'}. - {'chase pointers'. #chaseSelectionPointers}. - {'explore pointers'. #exploreSelectionPointers} }.! Item was removed: - ----- Method: Inspector>>applyUserInterfaceTheme (in category 'user interface') ----- - applyUserInterfaceTheme - - super applyUserInterfaceTheme. - - self fieldListStyler ifNotNil: [:styler | - styler reset. - self updateFieldList].! Item was added: + ----- Method: Inspector>>baseFieldList (in category 'accessing') ----- + baseFieldList + "Answer an Array consisting of 'self' + and the instance variable names of the inspected object." + + ^ (Array with: 'self' with: 'all inst vars') + , object class allInstVarNames! Item was changed: + ----- Method: Inspector>>browseClass (in category 'menu commands') ----- - ----- Method: Inspector>>browseClass (in category 'menu - commands') ----- browseClass "Open a full browser on the class of the selected item" + ToolSet browseClass: self selectedClass! - ^ ToolSet browseClass: self classOfSelection! Item was removed: - ----- Method: Inspector>>browseClassHierarchy (in category 'menu - commands') ----- - browseClassHierarchy - "Open a class list browser on the receiver's hierarchy." - - ^ self systemNavigation browseHierarchy: self classOfSelection! Item was removed: - ----- Method: Inspector>>browseVariableAssignments (in category 'menu - commands') ----- - browseVariableAssignments - - ^ self selectedInstVarName - ifNotNil: [:instVar | self systemNavigation - browseAllStoresInto: instVar - from: self object class] - ifNil: [self systemNavigation browseVariableAssignments: self object class]! Item was removed: - ----- Method: Inspector>>browseVariableReferences (in category 'menu - commands') ----- - browseVariableReferences - - ^ self selectedInstVarName - ifNotNil: [:instVar | self systemNavigation - browseAllAccessesTo: instVar - from: self object class] - ifNil: [self systemNavigation browseVariableReferences: self object class]! Item was changed: ----- Method: Inspector>>buildCodePaneWith: (in category 'toolbuilder') ----- buildCodePaneWith: builder + | textSpec | + textSpec := builder pluggableCodePaneSpec new. + textSpec - "Overridden. Note that I do not hold #contents in my code pane. See my value pane for that." - - ^ builder pluggableCodePaneSpec new model: self; getText: #expression; editText: #expression:; + help: #helpText; + selection: #contentsSelection; - help: 'Evaluate expressions on inspected object' translated; menu: #codePaneMenu:shifted:; + askBeforeDiscardingEdits: false. + ^textSpec! - askBeforeDiscardingEdits: false; - yourself! Item was changed: ----- Method: Inspector>>buildExploreButtonWith: (in category 'toolbuilder') ----- buildExploreButtonWith: builder ^ builder pluggableButtonSpec new model: self; + label: 'explore'; + action: #exploreObject; + help: 'Switch to an explorer tool'! - label: 'explore' translated; - action: #replaceInspectorWithExplorer; - help: 'Switch to an explorer tool' translated; - yourself! Item was changed: ----- Method: Inspector>>buildFieldListWith: (in category 'toolbuilder') ----- buildFieldListWith: builder + | listSpec | + listSpec := builder pluggableListSpec new. + listSpec - ^ builder pluggableListSpec new model: self; + list: #fieldList; + getIndex: #selectionIndex; + setIndex: #toggleIndex:; + menu: #fieldListMenu:; - list: #fieldList; - getIndex: #selectionIndex; - setIndex: #selectionIndex:; - autoDeselect: true; - menu: #fieldListMenu:shifted:; dragItem: #dragFromFieldList:; + dropItem: #dropOnFieldList:at:; + dropAccept: #wantsDropOnFieldList:type:source:; + keyPress: #inspectorKey:from:. + ^listSpec! - dropItem: #dropOnFieldList:at:shouldCopy:; - keyPress: #inspectorKey:from:; - yourself! Item was changed: ----- Method: Inspector>>buildValuePaneWith: (in category 'toolbuilder') ----- buildValuePaneWith: builder + | textSpec | + textSpec := builder pluggableCodePaneSpec new. + textSpec - "The value pane holds this StringHolder's contents." - - ^ builder pluggableCodePaneSpec new model: self; name: #valuePane; + getText: #contents; + setText: #accept:; + editText: #typeValue:; + help: 'Selection details.'; + selection: #contentsSelection; + menu: #codePaneMenu:shifted:. + ^textSpec! - getText: #contents; - setText: #contents:notifying:; - editText: #typeValue:; "Turn on code styling as you type." - help: 'Selected field''s value' translated; - menu: #codePaneMenu:shifted:; "Share the menu with the code pane." - yourself! Item was changed: ----- Method: Inspector>>buildWith: (in category 'toolbuilder') ----- buildWith: builder "Inspector openOn: SystemOrganization" + | windowSpec specs buttonOffset | - - | windowSpec buttonOffset | buttonOffset := (Preferences standardButtonFont widthOfString: 'explore') * 3/2. + + specs := { + (0 at 0 corner: 0.3 at 0.71) -> [self buildFieldListWith: builder]. + (0.3 at 0.0corner: 1 at 0.71) -> [self buildValuePaneWith: builder]. + (LayoutFrame fractions: (0 at 0.71 corner: 1 at 1) offsets: (0 at 0 corner: buttonOffset negated at 0)) -> [self buildCodePaneWith: builder]. + (LayoutFrame fractions: (1 at 0.71 corner: 1 at 1) offsets: (buttonOffset negated at 0 corner: 0 @ 0)) -> [self buildExploreButtonWith: builder] - windowSpec := self buildWindowWith: builder specs: { - (0 at 0 corner: 0.3 at 0.71) - -> [self buildFieldListWith: builder]. - (0.3 at 0.0 corner: 1 at 0.71) - -> [self buildValuePaneWith: builder]. - (LayoutFrame fractions: (0 at 0.71 corner: 1 at 1) offsets: (0 at 0 corner: buttonOffset negated at 0)) - -> [self buildCodePaneWith: builder]. - (LayoutFrame fractions: (1 at 0.71 corner: 1 at 1) offsets: (buttonOffset negated at 0 corner: 0 @ 0)) - -> [self buildExploreButtonWith: builder]. }. + + windowSpec := self buildWindowWith: builder specs: specs. + windowSpec extent: self initialExtent. + ^builder build: windowSpec! - ^ builder build: windowSpec! Item was added: + ----- Method: Inspector>>chasePointers (in category 'menu commands') ----- + chasePointers + | selected saved | + self selectionIndex = 0 ifTrue: [^ self changed: #flash]. + selected := self selection. + saved := self object. + [self object: nil. + (Smalltalk includesKey: #PointerFinder) + ifTrue: [PointerFinder on: selected] + ifFalse: [self inspectPointers]] + ensure: [self object: saved]! Item was removed: - ----- Method: Inspector>>chaseSelectionPointers (in category 'menu - commands') ----- - chaseSelectionPointers - - | selected saved | - self hasSelection ifFalse: [^ self changed: #flash]. - selected := self selectionOrObject. - saved := self object. - self object: nil. - ^ [(selected respondsTo: #chasePointers) - flag: #ct "Do we indeed need to isolate Tools-Inspector and Tools-Debugger?"; - flag: #ct "ToolSet"; - ifTrue: [selected chasePointers] - ifFalse: [selected inspectPointers]] - ensure: [self object: saved]! Item was changed: + ----- Method: Inspector>>classOfSelection (in category 'menu commands') ----- - ----- Method: Inspector>>classOfSelection (in category 'selection - convenience') ----- classOfSelection "Answer the class of the receiver's current selection" + self selectionUnmodifiable ifTrue: [^ object class]. + ^ self selection class! - ^ self selectionOrObject class! Item was removed: - ----- Method: Inspector>>contents:notifying: (in category 'accessing - contents') ----- - contents: aString notifying: aController - "Try to change the contents of the selected field. This is the usual callback for all string holders." - - | result | - result := self object class evaluatorClass new - evaluate: aString - in: self doItContext - to: self doItReceiver - notifying: aController - ifFail: [^ false]. - - ^ self replaceSelectionValue: result! Item was removed: - ----- Method: Inspector>>contentsForErrorDoing: (in category 'fields - error handling') ----- - contentsForErrorDoing: aBlock - - ^ 'An error occurred while inspecting this object. {1} to debug the error.' - translated asText format: { - Text - string: 'Click here' translated - attributes: { TextEmphasis bold. PluggableTextAttribute evalBlock: aBlock }}! Item was removed: - ----- Method: Inspector>>contentsForTruncationOf: (in category 'fields - truncation') ----- - contentsForTruncationOf: truncatedKeys - - ^ ('<Fields named {1} to {2} are not shown. {3} to inspect one of those fields or select "inspect element" from any field''s menu.>' translated asText - addAttribute: TextEmphasis italic; - format: { - truncatedKeys first storeString. - truncatedKeys last storeString. - 'Click here' translated asText - addAttribute: (PluggableTextAttribute evalBlock: [self inspectOneOf: truncatedKeys]); - yourself. })! Item was added: + ----- Method: Inspector>>contentsIsString (in category 'selecting') ----- + contentsIsString + "Hacked so contents empty when deselected and = long printString when item 2" + + ^ (selectionIndex = 2) | (selectionIndex = 0)! Item was changed: + ----- Method: Inspector>>contentsTyped (in category 'accessing') ----- - ----- Method: Inspector>>contentsTyped (in category 'accessing - contents') ----- contentsTyped ^ contentsTyped! Item was changed: + ----- Method: Inspector>>contentsTyped: (in category 'accessing') ----- - ----- Method: Inspector>>contentsTyped: (in category 'accessing - contents') ----- contentsTyped: aStringOrText contentsTyped := aStringOrText.! Item was removed: - ----- Method: Inspector>>context (in category 'accessing') ----- - context - - ^ context! Item was changed: ----- Method: Inspector>>context: (in category 'accessing') ----- context: ctxt + "Set the context of inspection. Currently only used by my subclass ClosureEnvInspector. The inst var is here because we do primitiveChangeClassTo: between subclasses (see inspect:) between different subclasses, but also context could be used as a general concept in all inspectors" - "Set the context of inspection, which is used for syntax highlighting and code evaluation." + context := ctxt! - context := ctxt.! Item was added: + ----- Method: Inspector>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- + convertToCurrentVersion: varDict refStream: smartRefStrm + + timeOfLastListUpdate ifNil: [timeOfLastListUpdate := 0]. + ^super convertToCurrentVersion: varDict refStream: smartRefStrm. + + ! Item was removed: - ----- Method: Inspector>>copyExpression (in category 'menu - commands') ----- - copyExpression - "From the selected field, copy the code expression that returns the contents of the value pane into the clipboard." - - (self expressionForField: self selectedField) - ifNil: [self error: 'Cannot determine field expression' translated] - ifNotNil: [:fieldExpression | Clipboard clipboardText: fieldExpression].! Item was changed: + ----- Method: Inspector>>copyName (in category 'menu commands') ----- - ----- Method: Inspector>>copyName (in category 'menu - commands') ----- copyName + "Copy the name of the current variable, so the user can paste it into the + window below and work with is. If collection, do (xxx at: 1)." + | sel aClass variableNames | + self selectionUnmodifiable + ifTrue: [^ self changed: #flash]. + aClass := self object class. + variableNames := aClass allInstVarNames. + (aClass isVariable and: [selectionIndex > (variableNames size + 2)]) + ifTrue: [sel := '(self basicAt: ' , (selectionIndex - (variableNames size + 2)) asString , ')'] + ifFalse: [sel := variableNames at: selectionIndex - 2]. + (self selection isKindOf: Collection) + ifTrue: [sel := '(' , sel , ' at: 1)']. + Clipboard clipboardText: sel asText! - "Copy the name of the selected field into clipboard." - - self selectedFieldName - ifNil: [self error: 'Cannot determine field name.' translated] - ifNotNil: [:name | Clipboard clipboardText: name].! Item was removed: - ----- Method: Inspector>>customFields (in category 'accessing') ----- - customFields - - ^ customFields! Item was added: + ----- Method: Inspector>>defaultIntegerBase (in category 'selecting') ----- + defaultIntegerBase + "Answer the default base in which to print integers. + Defer to the class of the instance." + ^[object class defaultIntegerBaseInDebugger] + on: MessageNotUnderstood + do: [:ex| 10]! Item was added: + ----- Method: Inspector>>defsOfSelection (in category 'menu commands') ----- + defsOfSelection + "Open a browser on all defining references to the selected instance variable, if that's what currently selected. " + | aClass sel | + + self selectionUnmodifiable ifTrue: [^ self changed: #flash]. + (aClass := self object class) isVariable ifTrue: [^ self changed: #flash]. + + sel := aClass allInstVarNames at: self selectionIndex - 2. + self systemNavigation browseAllStoresInto: sel from: aClass! Item was removed: - ----- Method: Inspector>>doItContext (in category 'accessing') ----- - doItContext - "Answer the context in which a text selection can be evaluated." - - ^ self context! Item was changed: + ----- Method: Inspector>>doItReceiver (in category 'code') ----- - ----- Method: Inspector>>doItReceiver (in category 'accessing') ----- doItReceiver + "Answer the object that should be informed of the result of evaluating a + text selection." - "Answer the object that should be informed of the result of evaluating a text selection." + ^object! - ^ self object! Item was changed: + ----- Method: Inspector>>dragFromFieldList: (in category 'drag-drop') ----- - ----- Method: Inspector>>dragFromFieldList: (in category 'fields - drag and drop') ----- dragFromFieldList: index + selectionIndex = index ifFalse: [self toggleIndex: index]. + ^self selection! - - ^ (self fields at: index ifAbsent: [nil]) - ifNotNil: [:fieldToDrag | fieldToDrag rememberInspector]! Item was added: + ----- Method: Inspector>>dropOnFieldList:at: (in category 'drag-drop') ----- + dropOnFieldList: anObject at: index + selectionIndex = index ifFalse: [self toggleIndex: index]. + self replaceSelectionValue: anObject. + self changed: #contents. + ^ true! Item was removed: - ----- Method: Inspector>>dropOnFieldList:at:shouldCopy: (in category 'fields - drag and drop') ----- - dropOnFieldList: anObjectOrField at: index shouldCopy: shouldCopyField - "Drop an object to change a field's value or drop a field to add it to the list of custom fields." - - (shouldCopyField and: [anObjectOrField isKindOf: self fieldClass]) - ifTrue: [ - self flag: #refactor. "mt: Instead of abusing #shouldCopy, write a separate hook for dropping fields between list items to insert fields." - self addCustomField: anObjectOrField forgetInspector copy] - ifFalse: [ - self selectionIndex: index. - self replaceSelectionValue: anObjectOrField value].! Item was removed: - ----- Method: Inspector>>elementAt: (in category 'menu - private') ----- - elementAt: indexOrKey - "Backstop to simplify #inspectOne for all kinds of inspectors." - - ^ (self elementGetterAt: indexOrKey) value: self object! Item was removed: - ----- Method: Inspector>>elementGetterAt: (in category 'menu - private') ----- - elementGetterAt: indexOrKey - "Backstop to simplify #inspectOne for all kinds of inspectors." - - ^ [:object | (self fields detect: [:field | field key = indexOrKey]) getValueFor: self] ! Item was removed: - ----- Method: Inspector>>emphasizeError: (in category 'fields - error handling') ----- - emphasizeError: errorMessage - - ^ ('<{1}>' asText format: { errorMessage }) - addAttribute: self textColorForError; - yourself! Item was removed: - ----- Method: Inspector>>ensureSelectedField (in category 'selection') ----- - ensureSelectedField - "If there is no field selected, try to select the first one." - - self hasSelection - ifFalse: [self selectionIndex: 1]. - - ^ self selectedField! Item was added: + ----- Method: Inspector>>exploreObject (in category 'toolbuilder') ----- + exploreObject + "Switch to an explorer tool." + + | window currentBounds | + currentBounds := ToolBuilder findDefault getBoundsForWindow: self containingWindow. + + "Close first because MVC fiddles around with processes." + self changed: #close. + + window := ToolSet explore: self object. + + "---- In MVC, the lines after this will not be executed ---" + + window model setExpression: self expression. + ToolBuilder findDefault setBoundsForWindow: window to: currentBounds.! Item was added: + ----- Method: Inspector>>explorePointers (in category 'menu commands') ----- + explorePointers + self selectionIndex = 0 ifTrue: [^ self changed: #flash]. + PointerExplorer openOn: self selection.! Item was changed: + ----- Method: Inspector>>exploreSelection (in category 'menu commands') ----- - ----- Method: Inspector>>exploreSelection (in category 'menu - commands') ----- exploreSelection + self selectionIndex = 0 ifTrue: [^ self changed: #flash]. + ^ self selection explore! - ^ self selectionOrObject explore! Item was removed: - ----- Method: Inspector>>exploreSelectionPointers (in category 'menu - commands') ----- - exploreSelectionPointers - - ^ self selectionOrObject explorePointers! Item was changed: + ----- Method: Inspector>>expression (in category 'accessing') ----- - ----- Method: Inspector>>expression (in category 'accessing - contents') ----- expression - "The code string in the code pane. Recorded for Inspector/Explorer switching. See #replaceInspectorWithExplorer." ^ expression ifNil: ['']! Item was changed: + ----- Method: Inspector>>expression: (in category 'accessing') ----- + expression: aString - ----- Method: Inspector>>expression: (in category 'accessing - contents') ----- - expression: aStringOrText - "The code string in the code pane. Recorded for Inspector/Explorer switching. See #replaceInspectorWithExplorer." + expression := aString.! - expression := aStringOrText.! Item was removed: - ----- Method: Inspector>>expressionForField: (in category 'fields') ----- - expressionForField: anInspectorField - "Subclasses can override this to configure the way to retrieve the source-code expression for the field." - - ^ anInspectorField valueGetterExpression! Item was removed: - ----- Method: Inspector>>fieldAllInstVars (in category 'fields') ----- - fieldAllInstVars - - ^ (self newFieldForType: #all key: #allInstVars) - name: 'all inst vars' translated; emphasizeName; - valueGetter: [:object | object longPrintString]; printValueAsIs; - yourself! Item was removed: - ----- Method: Inspector>>fieldClass (in category 'initialization') ----- - fieldClass - - ^ InspectorField! Item was changed: + ----- Method: Inspector>>fieldList (in category 'accessing') ----- - ----- Method: Inspector>>fieldList (in category 'user interface') ----- fieldList + "Answer the base field list plus an abbreviated list of indices." + + object class isVariable ifFalse: [^ self baseFieldList]. + ^ self baseFieldList , + (object basicSize <= (self i1 + self i2) + ifTrue: [(1 to: object basicSize) + collect: [:i | i printString]] + ifFalse: [(1 to: self i1) , (object basicSize-(self i2-1) to: object basicSize) + collect: [:i | i printString]])! - "Return a list of texts that identify the fields for the object under inspection so that the user can make an informed decision on what to inspect." - - ^ self fieldListStyler - ifNil: [self fields collect: [:field | field name]] - ifNotNil: [:styler | - self updateStyler: styler. - self fields collect: [:field | - field shouldStyleName - ifTrue: [styler styledTextFor: field name asText] - ifFalse: [field name]]]! Item was changed: + ----- Method: Inspector>>fieldListMenu: (in category 'menu commands') ----- - ----- Method: Inspector>>fieldListMenu: (in category 'menu') ----- fieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" ^ self menu: aMenu for: #(fieldListMenu fieldListMenuShifted:) ! Item was removed: - ----- Method: Inspector>>fieldListMenu:shifted: (in category 'menu') ----- - fieldListMenu: aMenu shifted: shifted - "Arm the supplied menu with items for the field-list of the receiver" - ^ self - menu: aMenu - for: #(fieldListMenu fieldListMenuShifted:) - shifted: shifted! Item was removed: - ----- Method: Inspector>>fieldListStyler (in category 'user interface - styling') ----- - fieldListStyler - "This is an extra styler to style the items in the field list. Note that both code and value pane use their own styler." - - ^ fieldListStyler! Item was removed: - ----- Method: Inspector>>fieldSelf (in category 'fields') ----- - fieldSelf - - ^ (self newFieldForType: #self key: #self) - shouldStyleName: true; - valueGetter: [:object | object]; - valueSetter: [:object :value | self object: value]; "Switch to another object-under-inspection." - yourself! Item was removed: - ----- Method: Inspector>>fields (in category 'accessing') ----- - fields - - ^ fields ifNil: [#()]! Item was removed: - ----- Method: Inspector>>getContents (in category 'user interface') ----- - getContents - - | newContents | - selectionUpdateTime := 0. - - self hasSelection ifFalse: [^ '']. - - selectionUpdateTime := [ - newContents := self selection in: [:object | - self selectedField shouldPrintValueAsIs - ifTrue: [object asStringOrText] "Show strings and texts without quoting and without ellipsis." - ifFalse: [object printString]]. - ] timeToRun. - - ^ newContents! Item was removed: - ----- Method: Inspector>>hasCustomFields (in category 'fields - custom') ----- - hasCustomFields - - ^ self customFields notEmpty! Item was removed: - ----- Method: Inspector>>hasSelection (in category 'selection') ----- - hasSelection - "Use #selectedField instead of #selectionIndex to guard against invalid #selectionIndex. Can happen, for example, when adding elements to sets." - - ^ self selectedField notNil! Item was added: + ----- Method: Inspector>>helpText (in category 'accessing') ----- + helpText + ^ 'evaluate expressions here'! Item was added: + ----- Method: Inspector>>i1 (in category 'accessing') ----- + i1 + "This is the max index shown before skipping to the + last i2 elements of very long arrays" + ^ 100! Item was added: + ----- Method: Inspector>>i2 (in category 'accessing') ----- + i2 + "This is the number of elements to show at the end + of very long arrays" + ^ 10! Item was changed: + ----- Method: Inspector>>initialExtent (in category 'accessing') ----- - ----- Method: Inspector>>initialExtent (in category 'initialization') ----- initialExtent "Answer the desired extent for the receiver when it is first opened on the screen. " ^ 350 @ 250! Item was changed: + ----- Method: Inspector>>initialize (in category 'initialize-release') ----- - ----- Method: Inspector>>initialize (in category 'initialization') ----- initialize - - super initialize. - customFields := OrderedCollection new. selectionIndex := 0. + shouldStyleValuePane := true. + super initialize! - - fieldListStyler := (Smalltalk classNamed: 'SHTextStylerST80') - ifNotNil: [:class | class new].! Item was changed: + ----- Method: Inspector>>inspect: (in category 'initialize-release') ----- - ----- Method: Inspector>>inspect: (in category 'initialization') ----- inspect: anObject + "Initialize the receiver so that it is inspecting anObject. There is no current selection. - "Reinitialize the receiver so that it is inspecting anObject. Become an instance of the appropriate inspectorClass. + Normally the receiver will be of the correct class (as defined by anObject inspectorClass), + because it will have just been created by sedning inspect to anObject. However, the + debugger uses two embedded inspectors, which are re-targetted on the current receiver + each time the stack frame changes. The left-hand inspector in the debugger has its + class changed by the code here. Care should be taken if this method is overridden to + ensure that the overriding code calls 'super inspect: anObject', or otherwise ensures that + the class of these embedded inspectors are changed back." - Normally the receiver will be of the correct class (as defined by anObject inspectorClass), because it will have just been created by sending inspect to anObject. However, the debugger uses two embedded inspectors, which are re-targetted on the current receiver each time the stack frame changes. The left-hand inspector in the debugger has its class changed by the code here." + | c | + c := anObject inspectorClass. + self class ~= c ifTrue: [ + self class format = c format + ifTrue: [self primitiveChangeClassTo: c basicNew] + ifFalse: [self becomeForward: (c basicNew copyFrom: self)]]. + "Set 'object' before sending the initialize message, because some implementations + of initialize (e.g., in DictionaryInspector) require 'object' to be non-nil." - | inspectorClass | - inspectorClass := anObject inspectorClass. - self class ~= inspectorClass ifTrue: [ - self class format = inspectorClass format - ifTrue: [self primitiveChangeClassTo: inspectorClass basicNew] - ifFalse: [self becomeForward: (self as: inspectorClass)]]. + object := anObject. + self initialize! - self object: anObject.! Item was added: + ----- Method: Inspector>>inspectBasic (in category 'menu commands') ----- + inspectBasic + "Bring up a non-special inspector" + + selectionIndex = 0 ifTrue: [^ object basicInspect]. + self selection basicInspect! Item was added: + ----- Method: Inspector>>inspectElement (in category 'menu commands') ----- + inspectElement + | sel selSize countString count nameStrs | + "Create and schedule an Inspector on an element of the receiver's model's currently selected collection." + + self selectionIndex = 0 ifTrue: [^ self changed: #flash]. + ((sel := self selection) isKindOf: SequenceableCollection) ifFalse: + [(sel respondsTo: #inspectElement) ifTrue: [^ sel inspectElement]. + ^ sel inspect]. + (selSize := sel size) = 1 ifTrue: [^ sel first inspect]. + selSize <= 20 ifTrue: + [nameStrs := (1 to: selSize) asArray collect: [:ii | + ii printString, ' ', (((sel at: ii) printStringLimitedTo: 25) replaceAll: Character cr with: Character space)]. + count := UIManager default chooseFrom: (nameStrs substrings) title: 'which element?'. + count = 0 ifTrue: [^ self]. + ^ (sel at: count) inspect]. + + countString := UIManager default request: 'Which element? (1 to ', selSize printString, ')' initialAnswer: '1'. + countString isEmptyOrNil ifTrue: [^ self]. + count := Integer readFrom: (ReadStream on: countString). + (count > 0 and: [count <= selSize]) + ifTrue: [(sel at: count) inspect] + ifFalse: [Beeper beep]! Item was removed: - ----- Method: Inspector>>inspectOne (in category 'menu - commands') ----- - inspectOne - "This is the most generic case to inspect a specific element from the inspected object. Since trunction of fields is a generic feature, support lookup for those truncated objects also for non-collections." - - self inspectOneOf: ( - self fields - select: [:field | field key notNil] - thenCollect: [:field | field key]).! Item was removed: - ----- Method: Inspector>>inspectOneOf: (in category 'menu - commands') ----- - inspectOneOf: someKeys - - | elements labels choice | - someKeys size = 0 ifTrue: [^ self inform: 'Nothing to inspect.' translated]. - someKeys size = 1 ifTrue: [^ (self elementAt: someKeys first) inspect]. - someKeys size > 50 ifTrue: [^ self inspectOneOfFrom: someKeys first to: someKeys last]. - - elements := someKeys collect: [:key | [self elementAt: key] ifError: ['<???>']]. - labels := someKeys with: elements collect: [:key :element | - '{1} -> {2}' format: { - key printString. - [element printString withoutLineEndings withBlanksCondensed truncateWithElipsisTo: 75] - ifError: ['<???>']}]. - choice := Project uiManager chooseFrom: labels title: 'Inspect which field?'. - choice = 0 ifTrue: [^ self]. - - (elements at: choice) inspect.! Item was removed: - ----- Method: Inspector>>inspectOneOfFrom:to: (in category 'menu - commands') ----- - inspectOneOfFrom: firstKey to: lastKey - "Let the user specify the desired field's key in the form of a Smalltalk literal or otherwise simple code expression." - - | choiceString | - choiceString := Project uiManager - request: ('Enter the name of the field to inspect.\Names range from {1} to {2}.' translated withCRs - format: {firstKey storeString. lastKey storeString}) - initialAnswer: firstKey storeString. - choiceString isEmptyOrNil ifTrue: [^ self]. - - (self elementAt: (Compiler evaluate: choiceString)) inspect.! Item was changed: + ----- Method: Inspector>>inspectSelection (in category 'menu commands') ----- - ----- Method: Inspector>>inspectSelection (in category 'menu - commands') ----- inspectSelection "Create and schedule an Inspector on the receiver's model's currently selected object." + self selectionIndex = 0 ifTrue: [^ self changed: #flash]. + self selection inspect. + ^ self selection! - self hasSelection ifFalse: [^ self changed: #flash]. - ^ self selectionOrObject inspect! Item was removed: - ----- Method: Inspector>>inspectSelectionBasic (in category 'menu - commands') ----- - inspectSelectionBasic - "Bring up an inspector that focuses on the very basics of an object." - - ^ ToolSet basicInspect: self selectionOrObject! Item was changed: + ----- Method: Inspector>>inspectorKey:from: (in category 'menu commands') ----- - ----- Method: Inspector>>inspectorKey:from: (in category 'menu') ----- inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list" + aChar == $i ifTrue: [^ self selection inspect]. + aChar == $I ifTrue: [^ self selection explore]. + aChar == $b ifTrue: [^ self browseClass]. + aChar == $h ifTrue: [^ self classHierarchy]. + aChar == $c ifTrue: [^ self copyName]. + aChar == $p ifTrue: [^ self browseFullProtocol]. + aChar == $N ifTrue: [^ self browseClassRefs]. + aChar == $t ifTrue: [^ self tearOffTile]. + aChar == $v ifTrue: [^ self viewerForValue]. + + ^ self arrowKey: aChar from: view! - ^ aChar - caseOf: { - [$x] -> [self removeSelection]. - - [$i] -> [self inspectSelection]. - [$I] -> [self exploreSelection]. - [$b] -> [self browseClass]. - [$h] -> [self browseClassHierarchy]. - [$p] -> [self browseFullProtocol]. - [$r] -> [self browseVariableReferences]. - [$a] -> [self browseVariableAssignments]. - [$N] -> [self browseClassRefs]. - [$c] -> [self copyName]. - [$t] -> [self tearOffTile]. - [$v] -> [self viewerForValue] } - otherwise: [self arrowKey: aChar from: view]! Item was removed: - ----- Method: Inspector>>labelString (in category 'user interface - window') ----- - labelString - "See #windowTitle. All tools chose to implement #labelString." - - ^ '{1}{2}' format: { - self object defaultLabelForInspector. - self object isReadOnlyObject - ifTrue: [' (read-only)'] - ifFalse: ['']}! Item was changed: + ----- Method: Inspector>>mainFieldListMenu: (in category 'menu commands') ----- - ----- Method: Inspector>>mainFieldListMenu: (in category 'menu') ----- mainFieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" <fieldListMenu> + "gets overriden by subclasses, _whithout_ the <fieldListMenu>" aMenu addStayUpItemSpecial. - - self addObjectItemsTo: aMenu. - - (#(self ellipsis element nil) includes: self typeOfSelection) - ifTrue: [self addCollectionItemsTo: aMenu]. + aMenu addList: #( + ('inspect (i)' inspectSelection) + ('explore (I)' exploreSelection)). - self typeOfSelection = #instVar - ifTrue: [self addInstVarItemsTo: aMenu]. + self addCollectionItemsTo: aMenu. - self addFieldItemsTo: aMenu. - self addClassItemsTo: aMenu. - - Smalltalk isMorphic ifTrue: [ - self flag: #refactor. "mt: Extract Etoys-specific extension." - "ct: We could use the <fieldListMenu> pragma if it had a priority argument!!" - self addEtoysItemsTo: aMenu]. + aMenu addList: #( + - + ('method refs to this inst var' referencesToSelection) + ('methods storing into this inst var' defsOfSelection) + ('objects pointing to this value' objectReferencesToSelection) + ('chase pointers' chasePointers) + ('explore pointers' explorePointers) + - + ('browse full (b)' browseClass) + ('browse hierarchy (h)' classHierarchy) + ('browse protocol (p)' browseFullProtocol) + - + ('references... (r)' browseVariableReferences) + ('assignments... (a)' browseVariableAssignments) + ('class refs (N)' browseClassRefs) + - + ('copy name (c)' copyName) + ('basic inspect' inspectBasic)). + + Smalltalk isMorphic ifTrue: + [aMenu addList: #( + - + ('tile for this value (t)' tearOffTile) + ('viewer for this value (v)' viewerForValue))]. + + ^ aMenu + + + " - + ('alias for this value' aliasForValue) + ('watcher for this slot' watcherForSlot)" + + ! - ^ aMenu! Item was removed: - ----- Method: Inspector>>metaFieldListMenu: (in category 'menu') ----- - metaFieldListMenu: aMenu - <fieldListMenu"Shifted: true"> - self flag: #ct "we need keyboard support for shifted menus. Maybe add an item 'More...'?". - - aMenu addLine. - aMenu addTranslatedList: #( - ('add field...' #addCustomField)). - self selectedField ifNotNil: [:field | - field isCustom ifTrue: [ - field addCustomItemsFor: self to: aMenu]]. - ^ aMenu! Item was changed: + ----- Method: Inspector>>modelWakeUpIn: (in category 'accessing') ----- - ----- Method: Inspector>>modelWakeUpIn: (in category 'updating - steps') ----- modelWakeUpIn: aWindow + | newText | + self updateListsAndCodeIn: aWindow. + newText := self contentsIsString + ifTrue: [newText := self selection] + ifFalse: ["keep it short to reduce time to compute it" + self selectionPrintString ]. + self setContents: newText.! - - self updateFields.! Item was removed: - ----- Method: Inspector>>newCustomField (in category 'fields - custom') ----- - newCustomField - - ^ (self newFieldForType: #custom) - valueGetterExpression: 'self yourself'; - yourself! Item was removed: - ----- Method: Inspector>>newFieldForType: (in category 'fields') ----- - newFieldForType: aSymbol - - ^ self fieldClass type: aSymbol! Item was removed: - ----- Method: Inspector>>newFieldForType:key: (in category 'fields') ----- - newFieldForType: aSymbol key: anObject - - ^ self fieldClass type: aSymbol key: anObject! Item was changed: + ----- Method: Inspector>>noteSelectionIndex:for: (in category 'accessing') ----- - ----- Method: Inspector>>noteSelectionIndex:for: (in category 'selection') ----- noteSelectionIndex: anInteger for: aSymbol + aSymbol == #fieldList + ifTrue: + [selectionIndex := anInteger]! - - self flag: #mvcOnly. - aSymbol == #fieldList ifTrue: - [selectionIndex := anInteger].! Item was changed: ----- Method: Inspector>>object: (in category 'accessing') ----- + object: anObject + "Set anObject to be the object being inspected by the receiver." - object: anObject - "Set anObject to be the object being inspected by the receiver. The current contents, including edits, in the value pane become void because the new object is likely to have new fields with different contents." + | oldSelection oldFields newFields commonFieldRange | + anObject == object + ifTrue: [self update] + ifFalse: + [oldSelection := selectionIndex. + oldFields := self fieldList. + self inspect: anObject. + newFields := self fieldList. + commonFieldRange := ((1 to: (oldFields size min: newFields size)) + select: [:i | (oldFields at: i) = (newFields at: i)]) + ifNotEmpty: #last + ifEmpty: [0]. + self changed: #inspectObject. + self toggleIndex: (oldSelection <= commonFieldRange + ifTrue: [oldSelection] + ifFalse: [0]). + self changed: #fieldList. + self changed: #contents. + self changed: #helpText]! - self object == anObject ifTrue: [^ self]. - self resetContents. - - object := anObject. - self changed: #object. - - self changed: #windowTitle. - - self updateFields.! Item was changed: + ----- Method: Inspector>>objectReferencesToSelection (in category 'menu commands') ----- - ----- Method: Inspector>>objectReferencesToSelection (in category 'menu - commands') ----- objectReferencesToSelection + "Open a list inspector on all the objects that point to the value of the selected instance variable, if any. " - "Open a list inspector on all the objects that point to the value of the selected object." + self selectionIndex = 0 ifTrue: [^ self changed: #flash]. + self systemNavigation + browseAllObjectReferencesTo: self selection + except: (Array with: self object) + ifNone: [:obj | self changed: #flash]. + ! - ^ self systemNavigation - browseAllObjectReferencesTo: self selectionOrObject - except: (Array with: self with: self object) - ifNone: [:obj | self changed: #flash]! Item was removed: - ----- Method: Inspector>>okToClose (in category 'user interface - window') ----- - okToClose - - ^ super okToClose and: [self okToDiscardCustomFields]! Item was removed: - ----- Method: Inspector>>okToDiscardCustomFields (in category 'user interface - window') ----- - okToDiscardCustomFields - - ^ self hasCustomFields ==> [self confirm: (String streamContents: [:s | - s nextPutAll: 'All custom fields will be discarded:' translated. - self customFields do: [:field | - s crtab; nextPutAll: field name] ])]! Item was added: + ----- Method: Inspector>>printStringErrorText (in category 'private') ----- + printStringErrorText + | nm | + nm := self selectionIndex < 3 + ifTrue: ['self'] + ifFalse: [self selectedFieldName]. + ^ (nm + ifNil: ['no selection'] + ifNotNil: + [nm first isDigit + ifTrue: ['<error in printString: evaluate "(self at: ' , nm , ') printString" to debug>'] + ifFalse: ['<error in printString: evaluate "' , nm , ' printString" to debug>'] ]) asText! Item was added: + ----- Method: Inspector>>referencesToSelection (in category 'menu commands') ----- + referencesToSelection + "Open a browser on all references to the selected instance variable, if that's what currently selected. 1/25/96 sw" + | aClass sel | + + self selectionUnmodifiable ifTrue: [^ self changed: #flash]. + (aClass := self object class) isVariable ifTrue: [^ self changed: #flash]. + + sel := aClass allInstVarNames at: self selectionIndex - 2. + self systemNavigation browseAllAccessesTo: sel from: aClass! Item was removed: - ----- Method: Inspector>>removeCustomField: (in category 'fields - custom') ----- - removeCustomField: aField - - aField isCustom - ifFalse: [^ self changed: #flash]. - (self customFields includes: aField) - ifFalse: [^ self changed: #flash]. - - (self confirm: ('Do you really want to remove the field ''{1}''?' translated format: {aField name})) - ifFalse: [^ self]. - - self customFields remove: aField. - self updateFields.! Item was removed: - ----- Method: Inspector>>removeSelection (in category 'menu - commands') ----- - removeSelection - "In general, we can always remove custom fields. Specialized inspectors can offer to remove other fields such as those representing collection elements." - - self selectedField ifNotNil: [:field | - field isCustom ifTrue: [self removeCustomField: field]].! Item was removed: - ----- Method: Inspector>>replaceInspectorWithExplorer (in category 'toolbuilder') ----- - replaceInspectorWithExplorer - "Switch to an explorer tool. If there are custom fields, the user can choose to not discard them, which will just spawn a new explorer tool besides this inspector." - - | window currentBounds | - self okToDiscardCustomFields - ifFalse: [^ self object explore]. - - self customFields removeAll. - self changed: #acceptChanges. "We copy the current state anyway. See below." - currentBounds := ToolBuilder default class getBoundsForWindow: self containingWindow. - - "Close first because MVC fiddles around with processes." - self changed: #close. - - window := ToolSet explore: self object. - - "---- In MVC, the lines after this will not be executed ---" - - window model setExpression: self expression. - ToolBuilder default class setBoundsForWindow: window to: currentBounds.! Item was changed: + ----- Method: Inspector>>replaceSelectionValue: (in category 'selecting') ----- - ----- Method: Inspector>>replaceSelectionValue: (in category 'selection') ----- replaceSelectionValue: anObject + "The receiver has a list of variables of its inspected object. One of these + is selected. The value of the selected variable is set to the value, + anObject." + | basicIndex si instVarIndex | + selectionIndex <= 2 ifTrue: [ + self toggleIndex: (si := selectionIndex). + self toggleIndex: si. + ^ object]. + instVarIndex := selectionIndex - 2. + instVarIndex > object class instSize + ifFalse: [^ object instVarAt: instVarIndex put: anObject]. + object class isVariable or: [self error: 'Cannot replace selection']. + basicIndex := selectionIndex - 2 - object class instSize. + (object basicSize <= (self i1 + self i2) or: [basicIndex <= self i1]) + ifTrue: [^object basicAt: basicIndex put: anObject] + ifFalse: [^object basicAt: object basicSize - (self i1 + self i2) + basicIndex + put: anObject]! - "Set the value of the selected field to anObject. We have to answer whether this replacement worked or not." - - | target | - (target := self ensureSelectedField) ifNil: [^ false]. - - target type = #self ifTrue: [ - ^ (self confirm: 'This will exchange the inspected object.' translated) - ifTrue: [self inspect: anObject. true] - ifFalse: [false]]. - - target isReadOnly ifTrue: [ - self inform: 'You cannot replace the selected field because\it is read-only. Try to add a field setter.' withCRs. - ^ false]. - - self contentsTyped: nil. "Ensure to refresh the contents view." - - target - setValueFor: self - to: anObject. - - ^ true! Item was changed: + ----- Method: Inspector>>representsSameBrowseeAs: (in category 'morphic ui') ----- - ----- Method: Inspector>>representsSameBrowseeAs: (in category 'user interface') ----- representsSameBrowseeAs: anotherInspector - ^ self object == anotherInspector object! Item was removed: - ----- Method: Inspector>>requestCustomFieldOrCancel: (in category 'fields - custom') ----- - requestCustomFieldOrCancel: aBlock - - ^ self newCustomField - requestCustomFor: self - orCancel: aBlock! Item was removed: - ----- Method: Inspector>>resetContents (in category 'initialization') ----- - resetContents - - self setContents: nil.! Item was removed: - ----- Method: Inspector>>resetFields (in category 'initialization') ----- - resetFields - - "1) Discard existing fields." - fields ifNotNil: [ - fields do: [:field | field removeDependent: self]. - fields := nil "Just in case there is an error in the following calls."]. - - "2a) Create new fields." - fields := Array streamContents: [:stream | - | workBlock | - workBlock := [self streamFieldsOn: stream]. - workBlock ifError: [self streamErrorDoing: workBlock on: stream]]. - - "2b) Establish field dependency." - fields do: [:field | field addDependent: self]. - - "3) Tell the views." - self updateFieldList.! Item was removed: - ----- Method: Inspector>>selectField: (in category 'selection') ----- - selectField: aField - - self selectionIndex: (self fields indexOf: aField ifAbsent: [0])! Item was changed: + ----- Method: Inspector>>selectFieldNamed: (in category 'selecting') ----- - ----- Method: Inspector>>selectFieldNamed: (in category 'selection') ----- selectFieldNamed: aString - "Select the field that is labeled aFieldName, or nothing, is there is no match." + self selectedFieldName = aString ifTrue: [^ self]. + self toggleIndex: (self fieldList indexOf: aString).! - self selectFieldSuchThat: [:field | field name = aString].! Item was removed: - ----- Method: Inspector>>selectFieldSuchThat: (in category 'selection') ----- - selectFieldSuchThat: aBlock - "Select the first field for which aBlock evaluates to true." - - self selectionIndex: (self fields findFirst: aBlock).! Item was changed: + ----- Method: Inspector>>selectedClass (in category 'accessing') ----- - ----- Method: Inspector>>selectedClass (in category 'selection - convenience') ----- selectedClass + "Answer the class of the receiver's current selection" + self selectionUnmodifiable ifTrue: [^ object class]. + ^ self selection class! - ^ self object class! Item was removed: - ----- Method: Inspector>>selectedField (in category 'selection') ----- - selectedField - - ^ self fields - at: self selectionIndex - ifAbsent: [nil]! Item was changed: + ----- Method: Inspector>>selectedFieldName (in category 'selecting') ----- - ----- Method: Inspector>>selectedFieldName (in category 'selection') ----- selectedFieldName + ^ self fieldList at: self selectionIndex ifAbsent: []! - ^ self selectedField ifNotNil: [:field | field name]! Item was removed: - ----- Method: Inspector>>selectedInstVarName (in category 'selection - convenience') ----- - selectedInstVarName - - ^ self selectedField ifNotNil: [:field | - field type = #instVar - ifTrue: [field key] - ifFalse: [nil]].! Item was changed: + ----- Method: Inspector>>selection (in category 'selecting') ----- - ----- Method: Inspector>>selection (in category 'selection') ----- selection + "The receiver has a list of variables of its inspected object. + One of these is selected. Answer the value of the selected variable." + | basicIndex | + selectionIndex = 0 ifTrue: [^ '']. + selectionIndex = 1 ifTrue: [^ object]. + selectionIndex = 2 ifTrue: [^ object longPrintStringLimitedTo: 20000]. + (selectionIndex - 2) <= object class instSize + ifTrue: [^ object instVarAt: selectionIndex - 2]. + basicIndex := selectionIndex - 2 - object class instSize. + (object basicSize <= (self i1 + self i2) or: [basicIndex <= self i1]) + ifTrue: [^ object basicAt: basicIndex] + ifFalse: [^ object basicAt: object basicSize - (self i1 + self i2) + basicIndex]! - "Answer the value of the selected variable slot, that is an object." - - ^ self selectedField getValueFor: self! Item was changed: + ----- Method: Inspector>>selectionIndex (in category 'selecting') ----- - ----- Method: Inspector>>selectionIndex (in category 'accessing') ----- selectionIndex + "The receiver has a list of variables of its inspected object. One of these + is selected. Answer the index into the list of the selected variable." + ^selectionIndex! - ^ selectionIndex! Item was removed: - ----- Method: Inspector>>selectionIndex: (in category 'accessing') ----- - selectionIndex: anInteger - "Changes the index to determine the currently selected field. If the field is already selected, update the fields contents in the value pane." - - self selectionIndex = anInteger - ifTrue: [^ self updateContentsSafely]. - - selectionIndex := anInteger. - self changed: #selectionIndex. - - self updateContentsSafely.! Item was removed: - ----- Method: Inspector>>selectionIsReadOnly (in category 'selection - convenience') ----- - selectionIsReadOnly - "Answer if the current selected variable is not modifiable via acceptance in the code pane. For example, a selection of 'all inst vars' is unmodifiable." - - ^ self selectedField - ifNil: [true] - ifNotNil: [:field | field isReadOnly]! Item was removed: - ----- Method: Inspector>>selectionOrObject (in category 'selection - convenience') ----- - selectionOrObject - "My selection. If nothing useful is selected, return the inspected object instead." - - self hasSelection ifFalse: [^ self object]. - self typeOfSelection = #ellipsis ifTrue: [^ self object]. - - ^ self selection! Item was added: + ----- Method: Inspector>>selectionPrintString (in category 'selecting') ----- + selectionPrintString + | text | + selectionUpdateTime := [text := [self selection isInteger + ifTrue: [self selection storeStringBase: self defaultIntegerBase] + ifFalse: [self selection printStringLimitedTo: 5000]] + on: Error + do: [text := self printStringErrorText. + text + addAttribute: TextColor red + from: 1 + to: text size. + text]] timeToRun. + ^ text! Item was added: + ----- Method: Inspector>>selectionUnmodifiable (in category 'selecting') ----- + selectionUnmodifiable + "Answer if the current selected variable is modifiable via acceptance in the code pane. For most inspectors, no selection and a selection of 'self' (selectionIndex = 1) and 'all inst vars' (selectionIndex = 2) are unmodifiable" + + ^ selectionIndex <= 2! Item was changed: + ----- Method: Inspector>>setContents: (in category 'initialize-release') ----- - ----- Method: Inspector>>setContents: (in category 'initialization') ----- setContents: aStringOrText - "Do not style the value pane anymore. Clear the #contentsTyped buffer." - shouldStyleValuePane := false. super setContents: aStringOrText. self contentsTyped: nil.! Item was changed: + ----- Method: Inspector>>setContentsTyped: (in category 'initialize-release') ----- - ----- Method: Inspector>>setContentsTyped: (in category 'initialization') ----- setContentsTyped: aStringOrText "Simulate typing." - shouldStyleValuePane := true. self contentsTyped: aStringOrText. + self changed: #editString with: aStringOrText.! - - self flag: #refactor. "mt: #changed: is not able to specify the receiver ..." - self valuePane ifNotNil: [:pane | - pane update: #editString with: aStringOrText].! Item was changed: + ----- Method: Inspector>>setExpression: (in category 'code') ----- - ----- Method: Inspector>>setExpression: (in category 'initialization') ----- setExpression: aString - "Set the code string in the code pane after switching between Inspector/Explorer. See #replaceInspectorWithExplorer." self expression: aString. self changed: #expression.! Item was changed: + ----- Method: Inspector>>stepAt:in: (in category 'stepping') ----- - ----- Method: Inspector>>stepAt:in: (in category 'updating - steps') ----- stepAt: millisecondClockValue in: aWindow + | newText | + (Preferences smartUpdating and: [(millisecondClockValue - self timeOfLastListUpdate) > 8000]) "Not more often than once every 8 seconds" + ifTrue: + [self updateListsAndCodeIn: aWindow. + timeOfLastListUpdate := millisecondClockValue]. + + newText := self contentsIsString + ifTrue: [self selection] + ifFalse: ["keep it short to reduce time to compute it" + self selectionPrintString ]. + self setContents: newText.! - self updateFields.! Item was changed: + ----- Method: Inspector>>stepTimeIn: (in category 'accessing') ----- + stepTimeIn: aSystemWindow - ----- Method: Inspector>>stepTimeIn: (in category 'updating - steps') ----- - stepTimeIn: aWindow - "Minimum step time is 1 second. If the fetching of contents takes more than 100 milliseconds, increase the step time accordingly to keep the system responsive." - ^ (selectionUpdateTime ifNil: [0]) * 10 max: 1000! Item was removed: - ----- Method: Inspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- - streamBaseFieldsOn: aStream - - aStream - nextPut: self fieldSelf; - nextPut: self fieldAllInstVars.! Item was removed: - ----- Method: Inspector>>streamCustomFieldsOn: (in category 'fields - streaming') ----- - streamCustomFieldsOn: aStream - - aStream nextPutAll: self customFields.! Item was removed: - ----- Method: Inspector>>streamError:on: (in category 'fields - error handling') ----- - streamError: aMessageString on: aStream - - aStream nextPut: ((self newFieldForType: #error) - name: (Text - string: '<error>' translated - attribute: self textColorForError); - valueGetter: [:object | self emphasizeError: aMessageString]; - printValueAsIs; - yourself)! Item was removed: - ----- Method: Inspector>>streamErrorDoing:on: (in category 'fields - error handling') ----- - streamErrorDoing: aBlock on: aStream - - self - streamError: (self contentsForErrorDoing: aBlock) - on: aStream.! Item was removed: - ----- Method: Inspector>>streamFieldsOn: (in category 'fields - streaming') ----- - streamFieldsOn: aStream - - self - streamBaseFieldsOn: aStream; - streamVariableFieldsOn: aStream; - streamCustomFieldsOn: aStream.! Item was removed: - ----- Method: Inspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- - streamIndexedVariablesOn: aStream - "Truncate indexed variables if there are too many of them." - - self - streamOn: aStream - truncate: (1 to: self object basicSize) - collectFields: [:index | - (self newFieldForType: #indexed key: index) - valueGetter: [:object | object basicAt: index]; - valueSetter: [:object :value | object basicAt: index put: value]; - yourself]! Item was removed: - ----- Method: Inspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- - streamInstanceVariablesOn: aStream - - (self object perform: #class "do not inline send of #class, receiver could be a proxy") allInstVarNames doWithIndex: [:name :index | - aStream nextPut: ((self newFieldForType: #instVar key: name) - shouldStyleName: true; - valueGetter: [:object | object instVarNamed: name]; - valueSetter: [:object :value | object instVarNamed: name put: value]; - yourself)].! Item was removed: - ----- Method: Inspector>>streamOn:truncate:collectFields: (in category 'fields - truncation') ----- - streamOn: aStream truncate: aList collectFields: aBlock - - ^ self - streamOn: aStream - truncate: aList - collectFields: aBlock - ellipsisFrom: [:truncatedObjects | (self newFieldForType: #ellipsis) - name: '...'; - valueGetter: [:object | self contentsForTruncationOf: truncatedObjects]; - printValueAsIs; - yourself]! Item was removed: - ----- Method: Inspector>>streamOn:truncate:collectFields:ellipsisFrom: (in category 'fields - truncation') ----- - streamOn: aStream truncate: someObjects collectFields: fieldBlock ellipsisFrom: ellipsisBlock - "Create fields for someObjects using fieldBlock. Using the current #truncationLimit, create an extra ellipsis field to hide objects that go beyond this limit." - - (someObjects size <= self truncationLimit or: [self truncationLimit < 0]) - ifTrue: [^ aStream nextPutAll: (someObjects collect: [:each | fieldBlock value: each])]. - - someObjects readStream in: [:readStream | - aStream - nextPutAll: ((readStream next: self truncationLimit - self truncationTail - 1) - collect: [:each | fieldBlock value: each]); - nextPut: (ellipsisBlock value: (readStream upToPosition: readStream size - self truncationTail)); - nextPutAll: (readStream upToEnd - collect: [:each | fieldBlock value: each])].! Item was removed: - ----- Method: Inspector>>streamVariableFieldsOn: (in category 'fields - streaming') ----- - streamVariableFieldsOn: aStream - - self - streamInstanceVariablesOn: aStream; - streamIndexedVariablesOn: aStream.! Item was removed: - ----- Method: Inspector>>textColorForError (in category 'user interface') ----- - textColorForError - - ^ TextColor color: ((self userInterfaceTheme get: #errorColor for: #TestRunner) ifNil: [Color red])! Item was added: + ----- Method: Inspector>>timeOfLastListUpdate (in category 'accessing') ----- + timeOfLastListUpdate + ^ timeOfLastListUpdate ifNil: [timeOfLastListUpdate := 0]! Item was added: + ----- Method: Inspector>>toggleIndex: (in category 'selecting') ----- + toggleIndex: anInteger + "The receiver has a list of variables of its inspected object. One of these + is selected. If anInteger is the index of this variable, then deselect it. + Otherwise, make the variable whose index is anInteger be the selected + item." + + | newText | + selectionUpdateTime := 0. + selectionIndex = anInteger + ifTrue: + ["same index, turn off selection" + selectionIndex := 0. + newText := ''] + ifFalse: + ["different index, new selection" + shouldStyleValuePane := false. + selectionIndex := anInteger. + self contentsIsString + ifTrue: [newText := self selection] + ifFalse: [newText := self selectionPrintString]]. + self setContents: newText. + self changed: #selection. + self changed: #selectionIndex.! Item was added: + ----- Method: Inspector>>trash (in category 'accessing') ----- + trash + "What goes in the bottom pane" + ^ ''! Item was added: + ----- Method: Inspector>>trash: (in category 'accessing') ----- + trash: newText + "Don't save it" + ^ true! Item was removed: - ----- Method: Inspector>>truncationLimit (in category 'fields - truncation') ----- - truncationLimit - "The maximum number of fields to show when truncating a list of objects. For example, collections can have a very big number of indexed variables and the inspecter would become slow without this limit. Keep the system responsive. Note that there is an extra ellipsis field for the truncated items so that users can manually select the (truncated) indexed variable to inspect. - - Choose a limit < 0 to not truncate any fields." - - ^ 100! Item was removed: - ----- Method: Inspector>>truncationTail (in category 'fields - truncation') ----- - truncationTail - "The number of fields to show at the end of a truncated field run." - - ^ 10! Item was removed: - ----- Method: Inspector>>typeOfSelection (in category 'selection - convenience') ----- - typeOfSelection - - ^ self selectedField ifNotNil: [:field | field type]! Item was changed: + ----- Method: Inspector>>typeValue: (in category 'selecting') ----- - ----- Method: Inspector>>typeValue: (in category 'user interface - styling') ----- typeValue: aTextOrString - "Style field value contents only after the user typed." - - contentsTyped := aTextOrString. + shouldStyleValuePane := true. + contentsTyped := aTextOrString. + self changed: #style.! - shouldStyleValuePane == true ifFalse: [ - shouldStyleValuePane := true. - self changed: #style].! Item was changed: + ----- Method: Inspector>>update (in category 'accessing') ----- - ----- Method: Inspector>>update (in category 'updating') ----- update + "Reshow contents, assuming selected value may have changed." - "For convenience." + | newText | + selectionIndex = 0 + ifFalse: + [self contentsIsString + ifTrue: [newText := self selection] + ifFalse: [newText := self selectionPrintString]. + self setContents: newText. + self changed: #selection. + self changed: #selectionIndex]! - self updateFields.! Item was removed: - ----- Method: Inspector>>update: (in category 'updating') ----- - update: what - - what = #field ifTrue: [ - self updateFieldList. - self updateContentsSafely]. - - ^ super update: what! Item was removed: - ----- Method: Inspector>>update:with: (in category 'updating') ----- - update: what with: parameter - - what = #deleteField - ifTrue: [self removeCustomField: parameter]. - - ^ super update: what with: parameter! Item was removed: - ----- Method: Inspector>>updateContentsSafely (in category 'updating') ----- - updateContentsSafely - "Force update contents of selected field. Do not style the contents anymore. Discard unaccepted changes in text fields." - - | workBlock | - workBlock := [self getContents]. - self setContents: (workBlock - ifError: [self emphasizeError: (self contentsForErrorDoing: workBlock)]).! Item was removed: - ----- Method: Inspector>>updateFieldList (in category 'updating') ----- - updateFieldList - - self changed: #fieldList. - self changed: #selectionIndex. "In case a field got renamed, tell the view that the selection did not change at all. The view would otherwise assume it is gone after updating the list and clear the selection. That's a little interference with the built-in list filtering mechanism in the view."! Item was removed: - ----- Method: Inspector>>updateFields (in category 'updating') ----- - updateFields - "Reset the collection of fields. Since amount and content my change, try to keep the current selection by field identity or field name." - - | field edits | - field := self hasSelection ifTrue: [self selectedField]. "Save user selection" - edits := self contentsTyped. "Save user edits" - - self resetFields. - - "Restore user selection" - field ifNotNil: [ - (self fields identityIncludes: field) - ifTrue: [self selectField: field] - ifFalse: [self selectFieldNamed: field name]]. - - "Restore user edits only if selection was restored." - (edits notNil and: [self selectedField = field or: [self selectedFieldName = field name]]) - ifTrue: [self setContentsTyped: edits]. - ! Item was removed: - ----- Method: Inspector>>updateListsAndCodeIn: (in category 'updating - steps') ----- - updateListsAndCodeIn: aWindow - "Not needed. We have everything in place to update from here. See #updateFields. No need to update through views."! Item was removed: - ----- Method: Inspector>>updateStyler: (in category 'user interface - styling') ----- - updateStyler: aStyler - - self updateStyler: aStyler requestor: self.! Item was removed: - ----- Method: Inspector>>updateStyler:requestor: (in category 'user interface - styling') ----- - updateStyler: aStyler requestor: anObject - "Use this method to update our fieldListStyler and all view stylers." - - aStyler - environment: self environment; - classOrMetaClass: (self doItReceiver perform: #class "do not inline send of #class, receiver could be a proxy"); - context: self doItContext; - parseAMethod: false.! Item was removed: - ----- Method: Inspector>>valuePane (in category 'user interface') ----- - valuePane - "Private. This is a workaround to interact with the value pane directly and not interfere with the code pane." - - ^ self dependents - detect: [:object | object knownName = #valuePane] - ifNone: []! Item was added: + ----- Method: Inspector>>viewerForValue (in category 'menu commands') ----- + viewerForValue + "Open up a viewer on the value of the receiver's current selection" + + | objectToRepresent | + objectToRepresent := self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection]. + objectToRepresent beViewed + ! Item was added: + ----- Method: Inspector>>wantsDropOnFieldList:type:source: (in category 'drag-drop') ----- + wantsDropOnFieldList: anObject type: type source: source + + ^ (source respondsTo: #model) and: [source model isKindOf: Inspector]! Item was added: + ----- Method: Inspector>>wantsSteps (in category 'accessing') ----- + wantsSteps + ^ true! Item was removed: - ----- Method: Inspector>>wantsStepsIn: (in category 'updating - steps') ----- - wantsStepsIn: aWindow - "Independent of #smartUpdating preference". - - ^ true! Item was changed: + Inspector subclass: #InspectorBrowser + instanceVariableNames: 'browser' - Model subclass: #InspectorBrowser - instanceVariableNames: 'inspector browser' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! !InspectorBrowser commentStamp: 'tcj 3/12/2018 07:55' prior: 0! I am an inspector that also shows all messages the inspected objects can understand. I combine inspector and code browser. InspectorBrowser openOn: Smalltalk! Item was removed: - ----- Method: InspectorBrowser class>>basicInspect: (in category 'inspector compatibility') ----- - basicInspect: anObject - "ToolBuilder open: (self basicInspect: Morph new)" - - ^ self new - setInspectorClass: BasicInspector; - object: anObject; - yourself! Item was removed: - ----- Method: InspectorBrowser class>>inspect: (in category 'inspector compatibility') ----- - inspect: anObject - "ToolBuilder open: (self inspect: 42)" - - ^ self new inspect: anObject! Item was removed: - ----- Method: InspectorBrowser class>>on: (in category 'instance creation') ----- - on: anObject - "We have to call #inspect: instead of #object: to choose the correct #inspectorClass." - - ^ self new inspect: anObject! Item was removed: - ----- Method: InspectorBrowser class>>openOn: (in category 'instance creation') ----- - openOn: anObject - - ^ ToolBuilder open: (self on: anObject)! Item was removed: - ----- Method: InspectorBrowser class>>openOn:withLabel: (in category 'instance creation') ----- - openOn: anObject withLabel: label - - ^ ToolBuilder open: (self on: anObject) label: label! Item was added: + ----- Method: InspectorBrowser>>browser (in category 'initialize-release') ----- + browser + + ^ browser ifNil: [browser := Browser new]! Item was changed: ----- Method: InspectorBrowser>>buildWith: (in category 'toolbuilder') ----- buildWith: builder | windowSpec | windowSpec := self buildWindowWith: builder specs: { + (0 at 0 corner: 0.3 at 0.3) -> [self buildFieldListWith: builder]. + (0.3 at 0 corner: 1.0 at 0.3) -> [self buildValuePaneWith: builder]. - (0 at 0 corner: 0.3 at 0.3) -> [inspector buildFieldListWith: builder]. - (0.3 at 0 corner: 1.0 at 0.3) -> [inspector buildValuePaneWith: builder]. (0 at 0.3 corner: 0.3 at 1.0) -> [browser buildMessageListWith: builder]. (0.3 at 0.3 corner: 1.0 at 1.0) -> [browser buildCodePaneWith: builder]. }. ^ builder build: windowSpec! Item was changed: + ----- Method: InspectorBrowser>>initialExtent (in category 'toolbuilder') ----- - ----- Method: InspectorBrowser>>initialExtent (in category 'initialization') ----- initialExtent + ^ super initialExtent * 3/2! - ^ (inspector initialExtent x max: browser initialExtent x) - @ ((inspector initialExtent y * 2/3) + browser initialExtent y)! Item was removed: - ----- Method: InspectorBrowser>>initialize (in category 'initialization') ----- - initialize - - super initialize. - - self setInspectorClass: Inspector. - self setBrowserClass: Browser.! Item was changed: + ----- Method: InspectorBrowser>>inspect: (in category 'initialize-release') ----- + inspect: anObject + "Initialize the receiver so that it is inspecting anObject. There is no current selection. + Overriden so that my class is not changed to 'anObject inspectorClass'." + + object := anObject. + self browser selectClass: anObject class. + self initialize + ! - ----- Method: InspectorBrowser>>inspect: (in category 'initialization') ----- - inspect: anObject - "Reinitialize the inspector so that it is inspecting anObject." - - inspector inspect: anObject. - browser setClass: anObject class.! Item was removed: - ----- Method: InspectorBrowser>>labelString (in category 'toolbuilder') ----- - labelString - "The window title" - - ^ 'Inspector Browser: ', inspector labelString! Item was removed: - ----- Method: InspectorBrowser>>modelWakeUpIn: (in category 'stepping') ----- - modelWakeUpIn: aWindow - - inspector modelWakeUpIn: aWindow. - browser modelWakeUpIn: aWindow.! Item was removed: - ----- Method: InspectorBrowser>>object (in category 'accessing') ----- - object - - ^ inspector object! Item was removed: - ----- Method: InspectorBrowser>>object: (in category 'accessing') ----- - object: anObject - "Set anObject to be the object being inspected by the receiver." - - inspector object: anObject. - browser setClass: anObject class.! Item was removed: - ----- Method: InspectorBrowser>>setBrowserClass: (in category 'initialization') ----- - setBrowserClass: aClass - - browser := aClass new.! Item was removed: - ----- Method: InspectorBrowser>>setInspectorClass: (in category 'initialization') ----- - setInspectorClass: aClass - - inspector := aClass new. - inspector addDependent: self.! Item was changed: + ----- Method: InspectorBrowser>>stepAt:in: (in category 'stepping and presenter') ----- - ----- Method: InspectorBrowser>>stepAt:in: (in category 'stepping') ----- stepAt: millisecondClockValue in: aWindow + super stepAt: millisecondClockValue in: aWindow. - inspector stepAt: millisecondClockValue in: aWindow. browser stepAt: millisecondClockValue in: aWindow.! Item was removed: - ----- Method: InspectorBrowser>>stepTimeIn: (in category 'stepping') ----- - stepTimeIn: aWindow - - ^ (inspector stepTimeIn: aWindow) - max: (browser stepTimeIn: aWindow)! Item was removed: - ----- Method: InspectorBrowser>>update: (in category 'updating') ----- - update: anAspect - "When the inspector exchanges the object-under-inspection, reset the class of my browser." - - anAspect = #object ifTrue: [ - browser setClass: inspector object class]. - anAspect = #windowTitle ifTrue: [ - self changed: #windowTitle]. - super update: anAspect.! Item was removed: - ----- Method: InspectorBrowser>>updateListsAndCodeIn: (in category 'stepping') ----- - updateListsAndCodeIn: aWindow - - inspector updateListsAndCodeIn: aWindow. - browser updateListsAndCodeIn: aWindow.! Item was removed: - ----- Method: InspectorBrowser>>wantsStepsIn: (in category 'stepping') ----- - wantsStepsIn: aWindow - - ^ (inspector wantsStepsIn: aWindow) - or: [browser wantsStepsIn: aWindow]! Item was removed: - Object subclass: #InspectorField - instanceVariableNames: 'key valueGetter valueGetterExpression valueSetter valueSetterExpression name shouldStyleName shouldStyleValue shouldPrintValueAsIs type inspector' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! - - !InspectorField commentStamp: 'mt 3/9/2020 14:34' prior: 0! - I represent a single field of an Inspector in which I am composed. - - I am basically a pair of #key and #value, but may have an extra human-readable #name to be shown in the Inspector's views. My #value can only be accessed in scope of an Inspector because I need an #object to work with.! Item was removed: - ----- Method: InspectorField class>>generateExpressionFrom:argumentNames: (in category 'support') ----- - generateExpressionFrom: aBlock argumentNames: argumentNames - - | blockNode arguments variables context receiver | - self flag: #experimental. - blockNode := aBlock decompile veryDeepCopy. "some literals are singletons, see #becomeForward: below" - arguments := blockNode arguments collect: #name. - variables := Dictionary new. - variables - at: #true put: true; - at: #false put: false; - at: #nil put: nil. - receiver := aBlock receiver. - receiver class allInstVarNames - withIndexDo: [:name :index | - variables at: name put: (receiver instVarAt: index)]. - context := aBlock outerContext. - context tempNames - withIndexDo: [:name :index | - variables at: name put: (context namedTempAt: index)]. - blockNode nodesDo: [:node | - self flag: #ct. "Should we introduce #nodesCollect: instead of using dangerous #becomeForward:?" - { - [node isVariableNode not]. - [| argumentIndex | - argumentIndex := arguments indexOf: node name. - argumentIndex isZero - ifFalse: [node name: (argumentNames at: argumentIndex)]; - not]. - [variables at: node name - ifPresent: [:value | - value isLiteral - ifTrue: [node becomeForward: (LiteralNode new key: value)]; - yourself] - ifAbsent: [^ nil]]. - } detect: #value ifNone: [^ nil]]. - ^ String streamContents: [:stream | - blockNode - printStatementsOn: stream - indent: 0].! Item was removed: - ----- Method: InspectorField class>>type: (in category 'instance creation') ----- - type: aSymbol - - ^ self new - type: aSymbol; - yourself! Item was removed: - ----- Method: InspectorField class>>type:key: (in category 'instance creation') ----- - type: aSymbol key: anObject - - ^ (self type: aSymbol) - key: anObject - yourself! Item was removed: - ----- Method: InspectorField>>addCustomItemsFor:to: (in category 'menu - construction') ----- - addCustomItemsFor: anInspector to: aMenu - - aMenu - addLine; - add: 'edit field name...' translated target: self selector: #editName; - add: 'edit field getter...' translated target: self selector: #editGetterFor: argument: anInspector; - add: (self valueSetter ifNil: ['add field setter...' translated] ifNotNil: ['edit field setter...' translated]) - target: self selector: #editSetterFor: argument: anInspector; - addLine; - add: ('remove field ''{1}'' (x)' translated format: {self name}) target: self selector: #delete.! Item was removed: - ----- Method: InspectorField>>deEmphasizeName (in category 'initialization') ----- - deEmphasizeName - - self flag: #hardcoded. - self name: (self name asText - addAttribute: (TextColor color: (self userInterfaceTheme get: #balloonTextColor for: #PluggableTextMorphPlus)); - yourself).! Item was removed: - ----- Method: InspectorField>>delete (in category 'custom - actions') ----- - delete - "Request the deletion of this field in my inspector's list of (custom) fields." - - self changed: #deleteField with: self.! Item was removed: - ----- Method: InspectorField>>editGetterFor: (in category 'custom - actions') ----- - editGetterFor: aStringHolder - - ^ self editGetterFor: aStringHolder orCancel: []! Item was removed: - ----- Method: InspectorField>>editGetterFor:orCancel: (in category 'custom - actions') ----- - editGetterFor: anInspector orCancel: aBlock - - | code | - code := Project uiManager - request: 'Please enter an evaluable expression<br>to <b>get</b> this field''s value:' translated asTextFromHtml - initialAnswer: self valueGetterExpression. - code isEmptyOrNil ifTrue: [^ aBlock value]. - - ^ self setGetterFor: anInspector to: code ifFail: aBlock! Item was removed: - ----- Method: InspectorField>>editName (in category 'custom - actions') ----- - editName - - ^ self editNameOrCancel: []! Item was removed: - ----- Method: InspectorField>>editNameOrCancel: (in category 'custom - actions') ----- - editNameOrCancel: aBlock - - | newTitle | - newTitle := Project uiManager - request: 'Please enter a new name for this field:' translated withCRs - initialAnswer: self name asString. - newTitle isEmptyOrNil ifTrue: [^ aBlock value]. - self name: newTitle; emphasizeName. - self changed: #field.! Item was removed: - ----- Method: InspectorField>>editSetterFor: (in category 'custom - actions') ----- - editSetterFor: anInspector - - ^ self editSetterFor: anInspector orCancel: []! Item was removed: - ----- Method: InspectorField>>editSetterFor:orCancel: (in category 'custom - actions') ----- - editSetterFor: anInspector orCancel: aBlock - - | code | - code := Project uiManager - request: 'Please enter an evaluable expression<br>to <b>set</b> this field''s value:' translated asTextFromHtml - initialAnswer: (self valueSetterExpression ifNil: '[:value | self ___: value]'). - code isEmptyOrNil ifTrue: [^ aBlock value]. - ^ self setSetterFor: anInspector to: code ifFail: aBlock! Item was removed: - ----- Method: InspectorField>>emphasizeName (in category 'initialization') ----- - emphasizeName - - | regularEmphasis customEmphasis | - - self flag: #hardcoded. - regularEmphasis := TextEmphasis italic. - customEmphasis := TextColor color: ((self userInterfaceTheme get: #highlightTextColor for: #SimpleHierarchicalListMorph) ifNil: [Color red]). - - self name: (self name asText - addAttribute: (self isCustom ifTrue: [customEmphasis] ifFalse: [regularEmphasis]); - yourself).! Item was removed: - ----- Method: InspectorField>>expressionWithReceiverName: (in category 'accessing - code') ----- - expressionWithReceiverName: receiverName - "The code string to run for getting the receiver's value. The receiver's name, which is usually #self, can be replaced to fit specific debugging scenarios such as ThisContext." - - ^ valueGetterExpression ifNil: [ - self valueGetter isCompiledCode - ifTrue: [ "precompiled user code" - self valueGetter getSource ] - ifFalse: [ "evaluable" - self class - generateExpressionFrom: self valueGetter - argumentNames: {receiverName} ] ]! Item was removed: - ----- Method: InspectorField>>forgetInspector (in category 'private') ----- - forgetInspector - - inspector := nil.! Item was removed: - ----- Method: InspectorField>>getValueFor: (in category 'evaluating') ----- - getValueFor: anInspector - - ^ self valueGetter isCompiledCode - ifTrue: [ "precompiled user code" - self valueGetter - valueWithReceiver: anInspector doItReceiver - arguments: ({anInspector doItContext} first: self valueGetter numArgs)] - ifFalse: [ "evaluable" - self valueGetter value: anInspector object ]! Item was removed: - ----- Method: InspectorField>>inspector (in category 'private') ----- - inspector - - ^ inspector ifNil: [self dependents - detect: [:object | object isKindOf: Inspector] - ifNone: [nil]]! Item was removed: - ----- Method: InspectorField>>isCustom (in category 'testing') ----- - isCustom - - ^ self type = #custom! Item was removed: - ----- Method: InspectorField>>isReadOnly (in category 'testing') ----- - isReadOnly - - ^ self valueSetter isNil! Item was removed: - ----- Method: InspectorField>>key (in category 'accessing') ----- - key - - ^ key! Item was removed: - ----- Method: InspectorField>>key: (in category 'accessing') ----- - key: anObject - - self key = anObject ifTrue: [^ self]. - key := anObject. - self changed: #field.! Item was removed: - ----- Method: InspectorField>>name (in category 'accessing') ----- - name - "Answers most human-readable name for this field. Not that the key can be any kind of object but this message should answer something that is already printable such as String or Text. If the sender could not rely on this, quoted strings could be confused with regular strings." - - ^ name ifNil: [valueGetterExpression ifNil: [key ifNil: [''] ifNotNil: [key asString]]]! Item was removed: - ----- Method: InspectorField>>name: (in category 'accessing') ----- - name: aString - - name = aString ifTrue: [^ self]. - name := aString. - self changed: #field.! Item was removed: - ----- Method: InspectorField>>printOn: (in category 'printing') ----- - printOn: aStream - - super printOn: aStream. - aStream - nextPut: $<; - print: self type; - nextPut: $>. - aStream - nextPutAll: ' named '; - print: self name asString.! Item was removed: - ----- Method: InspectorField>>printValueAsIs (in category 'initialization') ----- - printValueAsIs - - self shouldPrintValueAsIs: true.! Item was removed: - ----- Method: InspectorField>>rememberInspector (in category 'private') ----- - rememberInspector - - inspector := self inspector.! Item was removed: - ----- Method: InspectorField>>requestCustomFor:orCancel: (in category 'custom') ----- - requestCustomFor: anInspector orCancel: aBlock - - self setGetterFor: anInspector to: 'self yourself' ifFail: [^ self]. - self editGetterFor: anInspector orCancel: aBlock. - self emphasizeName.! Item was removed: - ----- Method: InspectorField>>setGetterFor:to:ifFail: (in category 'custom') ----- - setGetterFor: anInspector to: code ifFail: aBlock - - | getter | - getter := Compiler new - compiledMethodFor: code - in: anInspector doItContext - to: anInspector doItReceiver - notifying: nil - ifFail: [^ aBlock value]. - - self valueGetterExpression: code. - self valueGetter: getter. - - self changed: #field.! Item was removed: - ----- Method: InspectorField>>setSetterFor:to:ifFail: (in category 'custom') ----- - setSetterFor: anInspector to: code ifFail: aBlock - - | setter | - setter := Compiler new - evaluate: code - in: anInspector doItContext - to: anInspector doItReceiver - environment: anInspector environment - notifying: nil - ifFail: [^ aBlock value] - logged: false. - - self - flag: #experimental; "ct: We might want to change this when input-request dialogs can work with source code. See also http://forum.world.st/Changeset-requestCode-cs-td5110502.html for this proposal." - assert: [setter respondsTo: #value:] - description: 'Setter must be evaluable like a block with one argument' translated. - - self valueSetterExpression: code. - self valueSetter: [:object :value | setter value: value]. - - self changed: #field.! Item was removed: - ----- Method: InspectorField>>setValueFor:to: (in category 'evaluating') ----- - setValueFor: anInspector to: value - - self valueSetter isCompiledCode - ifTrue: [ "precompiled user code" - self valueSetter - valueWithReceiver: anInspector doItReceiver - arguments: ({value. anInspector doItContext} first: self valueSetter numArgs)] - ifFalse: [ "evaluable" - self valueSetter value: anInspector object value: value ]. - self changed: #field.! Item was removed: - ----- Method: InspectorField>>shouldPrintValueAsIs (in category 'accessing - printing') ----- - shouldPrintValueAsIs - "Whether to call #asString or #printString on this field's value." - - ^ shouldPrintValueAsIs ifNil: [false]! Item was removed: - ----- Method: InspectorField>>shouldPrintValueAsIs: (in category 'accessing - printing') ----- - shouldPrintValueAsIs: aBoolean - "Whether to call #asString or #printString on this field's value." - - shouldPrintValueAsIs := aBoolean.! Item was removed: - ----- Method: InspectorField>>shouldStyleName (in category 'accessing - printing') ----- - shouldStyleName - - ^ shouldStyleName ifNil: [false]! Item was removed: - ----- Method: InspectorField>>shouldStyleName: (in category 'accessing - printing') ----- - shouldStyleName: aBoolean - - self shouldStyleName = aBoolean ifTrue: [^ self]. - shouldStyleName := aBoolean. - self changed: #field.! Item was removed: - ----- Method: InspectorField>>shouldStyleValue (in category 'accessing - printing') ----- - shouldStyleValue - - ^ shouldStyleValue ifNil: [false]! Item was removed: - ----- Method: InspectorField>>shouldStyleValue: (in category 'accessing - printing') ----- - shouldStyleValue: aBoolean - - self shouldStyleValue = aBoolean ifTrue: [^ self]. - shouldStyleValue := aBoolean. - self changed: #field.! Item was removed: - ----- Method: InspectorField>>type (in category 'accessing') ----- - type - - ^ type! Item was removed: - ----- Method: InspectorField>>type: (in category 'accessing') ----- - type: aSymbol - - type := aSymbol! Item was removed: - ----- Method: InspectorField>>value (in category 'accessing') ----- - value - "For convenience only. If you have an #inspector, call #getValueFor: directly. It may be faster." - - ^ self getValueFor: self inspector! Item was removed: - ----- Method: InspectorField>>value: (in category 'accessing') ----- - value: anObject - "For convenience only. If you have an #inspector, call #setValueFor:to: directly. It may be faster." - - ^ self setValueFor: self inspector to: anObject! Item was removed: - ----- Method: InspectorField>>valueGetter (in category 'accessing - code') ----- - valueGetter - "The valueGetter will be used to fetch a value for this field. See comment in #valueGetter:." - - ^ valueGetter! Item was removed: - ----- Method: InspectorField>>valueGetter: (in category 'accessing - code') ----- - valueGetter: evaluable - "The valueGetter will be used to fetch a value for this field. The corresponding inspctor will provide an object to fetch the value from. - - Here are some examples: - - [:object | object size] -- The most basic case. - #negated --- A convenient shortcut. - [:object | self print: object] --- A closured helper to fetch the value. - - It is also possible to store a compiled method as a valueGetter. Then, the corresponding inspector will provide both #doItReceiver and #doItContext to execute that method to fetch the value for this field. So, this is like storing a compiled do-it expression." - - valueGetter := evaluable.! Item was removed: - ----- Method: InspectorField>>valueGetterExpression (in category 'accessing - code') ----- - valueGetterExpression - "The code string to run for getting the receiver's value." - - ^ self expressionWithReceiverName: #self! Item was removed: - ----- Method: InspectorField>>valueGetterExpression: (in category 'accessing - code') ----- - valueGetterExpression: aString - - valueGetterExpression := aString.! Item was removed: - ----- Method: InspectorField>>valueSetter (in category 'accessing - code') ----- - valueSetter - "The valueSetter will be used to manipulate the value for this field. See comment in #valueSetter:." - - ^ valueSetter! Item was removed: - ----- Method: InspectorField>>valueSetter: (in category 'accessing - code') ----- - valueSetter: oneArgEvaluable - "The valueSetter will be used to manipulate the value for this field. It follows the same semantics as the valueGetter, but expects one more argument, which is the new value to set. See also comment in #valueGetter:. - - Here are some examples: - - [:object :value | object someProperty: value] -- The most basic case. - #someProperty: --- A convenient shortcut. - [:object :value | self setProperty: value in: object] --- A closured helper to set the value." - - valueSetter := oneArgEvaluable! Item was removed: - ----- Method: InspectorField>>valueSetterExpression (in category 'accessing - code') ----- - valueSetterExpression - - ^ valueSetterExpression! Item was removed: - ----- Method: InspectorField>>valueSetterExpression: (in category 'accessing - code') ----- - valueSetterExpression: aString - - valueSetterExpression := aString.! Item was added: + ----- Method: Integer>>valueStringForDisplayMethod: (in category '*Tools-Explorer') ----- + valueStringForDisplayMethod: displayMethod + displayMethod = 'hexadecimal' ifTrue: [^'16r', (self printStringBase: 16)]. + displayMethod = 'octal' ifTrue: [^'8r', (self printStringBase: 8)]. + displayMethod = 'binary' ifTrue: [^'2r', (self printStringBase: 2)]. + ^self asStringOrText ! Item was removed: - ----- Method: MessageNames>>postAcceptBrowseFor: (in category 'morphic ui') ----- - postAcceptBrowseFor: anotherModel - - self searchString: anotherModel searchString.! Item was removed: - ----- Method: MessageSet>>deleteAllFromMessageList: (in category 'message functions') ----- - deleteAllFromMessageList: aCollection - "Delete the given messages from the receiver's message list" - | currIdx | - currIdx := self messageListIndex. - messageList := messageList copyWithoutAll: aCollection. - messageList ifNotEmpty: [self messageListIndex: {currIdx. messageList size.} min]! Item was changed: ----- Method: MessageSet>>mainMessageListMenu: (in category 'message list') ----- mainMessageListMenu: aMenu "Answer the message-list menu" <messageListMenuShifted: false> aMenu addList: #( ('what to show...' offerWhatToShowMenu) ('toggle break on entry' toggleBreakOnEntry) - ('browse full (b)' browseMethodFull) + ('browse hierarchy (h)' classHierarchy) - ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) ('copy selector (c)' copySelector) ('copy reference (C)' copyReference) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) ('class refs (N)' browseClassRefs) - ('remove method (x)' removeMessage) ('explore method' exploreMethod) ('inspect method' inspectMethod)). ^ aMenu! Item was removed: - ----- Method: MessageTrace>>deleteAllFromMessageList: (in category 'building') ----- - deleteAllFromMessageList: aCollection - "Delete the given messages from the receiver's message list" - - | newAutoSelectStrings newMessageSelections newSize set | - newSize := self messageList size - aCollection size. - newAutoSelectStrings := OrderedCollection new: newSize. - newMessageSelections := OrderedCollection new: newSize. - set := aCollection asSet. - self messageList withIndexDo: [:each :index | - (set includes: each) ifFalse: - [newAutoSelectStrings add: (autoSelectStrings at: index). - newMessageSelections add: (messageSelections at: index)]]. - super deleteAllFromMessageList: aCollection. - autoSelectStrings := newAutoSelectStrings. - messageSelections := newMessageSelections. - anchorIndex ifNotNil: - [ anchorIndex := anchorIndex min: messageList size ]! Item was changed: ----- Method: MessageTrace>>removeMessageFromBrowser (in category 'building') ----- removeMessageFromBrowser | indexToSelect | "Try to keep the same selection index." indexToSelect := (messageSelections indexOf: true) max: 1. + self selectedMessages do: [ :eachMethodReference | self deleteFromMessageList: eachMethodReference ]. - self deleteAllFromMessageList: self selectedMessages. self deselectAll. messageSelections ifNotEmpty: [ messageSelections at: (indexToSelect min: messageSelections size) "safety" put: true ]. anchorIndex := indexToSelect min: messageSelections size. self messageListIndex: anchorIndex ; reformulateList! Item was changed: ----- Method: MethodFinder>>initialize (in category 'initialize') ----- (excessive size, no diff calculated) Item was changed: + ----- Method: Object>>basicInspect (in category '*Tools-inspecting') ----- - ----- Method: Object>>basicInspect (in category '*Tools-Inspector') ----- basicInspect "Create and schedule an Inspector in which the user can examine the receiver's variables. This method should not be overriden." ToolSet basicInspect: self! Item was changed: + ----- Method: Object>>inspect (in category '*Tools-inspecting') ----- - ----- Method: Object>>inspect (in category '*Tools-Inspector') ----- inspect "Create and schedule an Inspector in which the user can examine the receiver's variables." ToolSet inspect: self! Item was changed: + ----- Method: Object>>inspectWithLabel: (in category '*Tools-inspecting') ----- - ----- Method: Object>>inspectWithLabel: (in category '*Tools-Inspector') ----- inspectWithLabel: aLabel "Create and schedule an Inspector in which the user can examine the receiver's variables." ToolSet inspect: self label: aLabel! Item was changed: + ----- Method: Object>>inspectorClass (in category '*Tools-inspecting') ----- - ----- Method: Object>>inspectorClass (in category '*Tools-Inspector') ----- inspectorClass "Answer the class of the inspector to be used on the receiver. Called by inspect; use basicInspect to get a normal (less useful) type of inspector." ^ Inspector! Item was changed: ----- Method: ObjectExplorer>>browseClassHierarchy (in category 'menus - actions') ----- browseClassHierarchy "Create and schedule a class list browser on the receiver's hierarchy." self systemNavigation spawnHierarchyForClass: self selectedClass + selector: nil + ! - selector: nil.! Item was changed: ----- Method: ObjectExplorer>>copyValue (in category 'menus - actions') ----- copyValue "Copy a description of the value of the current variable, so the user can paste it into the window below and work with it." + | value | + value := (self currentParent value respondsTo: #valueStringForDisplayMethod:) + ifTrue: [self currentParent value valueStringForDisplayMethod: self currentSelection key] + ifFalse: [self currentSelection value]. + Clipboard clipboardText: value asStringOrText.! - - Clipboard clipboardText: self currentSelection value asStringOrText. ! Item was changed: ----- Method: ObjectExplorer>>label (in category 'accessing') ----- label + ^ self rootObject printStringLimitedTo: 40! - ^ [self rootObject printStringLimitedTo: 40] ifError: ['a ' , self rootObject class]! Item was added: + ----- Method: OrderedCollection>>inspectorClass (in category '*Tools-Inspector') ----- + inspectorClass + "Answer the class of the inspector to be used on the receiver. Called by inspect; + use basicInspect to get a normal (less useful) type of inspector." + + ^OrderedCollectionInspector! Item was added: + Inspector subclass: #OrderedCollectionInspector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Inspector'! Item was added: + ----- Method: OrderedCollectionInspector>>fieldList (in category 'accessing') ----- + fieldList + object ifNil: [ ^ OrderedCollection new]. + ^ self baseFieldList , + (self objectSize <= (self i1 + self i2) + ifTrue: [(1 to: self objectSize) + collect: [:i | i printString]] + ifFalse: [(1 to: self i1) , (self objectSize - (self i2-1) to: self objectSize) + collect: [:i | i printString]]) + " + OrderedCollection new inspect + (OrderedCollection newFrom: #(3 5 7 123)) inspect + (OrderedCollection newFrom: (1 to: 1000)) inspect + "! Item was added: + ----- Method: OrderedCollectionInspector>>objectSize (in category 'private') ----- + objectSize + "Single stepping through a debugger might observe the state of an OrderedCollection + instance after creation by basicNew but before initiialisation. Thus 'object size' + throws a DNU error for arithmetic on a nil value that needs to be handled here." + + ^ [ object size ] on: Error do: [ 0 ] + ! Item was added: + ----- Method: OrderedCollectionInspector>>replaceSelectionValue: (in category 'selecting') ----- + replaceSelectionValue: anObject + "The receiver has a list of variables of its inspected object. One of these + is selected. The value of the selected variable is set to the value, anObject." + + (selectionIndex - 2) <= object class instSize + ifTrue: [^ super replaceSelectionValue: anObject]. + object at: self selectedObjectIndex put: anObject! Item was added: + ----- Method: OrderedCollectionInspector>>selectedObjectIndex (in category 'selecting') ----- + selectedObjectIndex + "Answer the index of the inspectee's collection that the current selection refers to." + + | basicIndex | + basicIndex := selectionIndex - 2 - object class instSize. + ^ (object size <= (self i1 + self i2) or: [basicIndex <= self i1]) + ifTrue: [basicIndex] + ifFalse: [object size - (self i1 + self i2) + basicIndex]! Item was added: + ----- Method: OrderedCollectionInspector>>selection (in category 'selecting') ----- + selection + "The receiver has a list of variables of its inspected object. + One of these is selected. Answer the value of the selected variable." + + (selectionIndex - 2) <= object class instSize + ifTrue: [^ super selection]. + ^ object at: self selectedObjectIndex! Item was changed: ----- Method: ProcessBrowser>>inspectPointers (in category 'process actions') ----- inspectPointers | tc pointers | tc := thisContext. pointers := PointerFinder pointersTo: selectedProcess except: { self processList. tc. self}. pointers isEmpty ifTrue: [^ self]. + OrderedCollectionInspector + openOn: pointers + withLabel: 'Objects pointing to ' , selectedProcess browserPrintString! - ToolSet - inspect: pointers - label: 'Objects pointing to ' , selectedProcess browserPrintString! Item was changed: + Inspector subclass: #SetInspector - CollectionInspector subclass: #SetInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! + !SetInspector commentStamp: '<historical>' prior: 0! + A verison of the Inspector specialized for inspecting Sets. It displays the elements of the set like elements of an array. Note that the indices, being phyical locations in the hash table, are not meaningful outside of the set.! - !SetInspector commentStamp: 'ct 1/12/2020 15:21' prior: 0! - I am an inspector that is specialized for inspecting Sets. I display the elements of the set like elements of an array. Note that the indices, being phyical locations in the hash table, are not meaningful outside of the set.! Item was added: + ----- Method: SetInspector>>arrayIndexForSelection (in category 'selecting') ----- + arrayIndexForSelection + ^ (self fieldList at: selectionIndex) asInteger! Item was added: + ----- Method: SetInspector>>copyName (in category 'menu commands') ----- + copyName + "Copy the name of the current variable, so the user can paste it into the + window below and work with is. If collection, do (xxx at: 1)." + | sel | + self selectionIndex <= (2 + object class instSize) + ifTrue: [super copyName] + ifFalse: [sel := '(self array at: ' + , (String streamContents: + [:strm | self arrayIndexForSelection storeOn: strm]) , ')'. + Clipboard clipboardText: sel asText]! Item was removed: - ----- Method: SetInspector>>elementGetterAt: (in category 'private') ----- - elementGetterAt: index - - ^ [:set | (set array at: index) enclosedSetElement]! Item was removed: - ----- Method: SetInspector>>elementIndices (in category 'private') ----- - elementIndices - "In the set's internal array, extract the indices that point to actual elements." - - | numIndices | - (numIndices := self objectSize) = 0 - ifTrue: [^#()]. - - ^ Array - new: numIndices - streamContents: [:stream | - self object array doWithIndex: [:element :index | - (self isElementValid: element) ifTrue: [stream nextPut: index]]]! Item was removed: - ----- Method: SetInspector>>elementSetterAt: (in category 'private') ----- - elementSetterAt: index - "Because of sets are hashed collections, we have to use the public interface, which means removing the element the index is pointing to first -- and only then can we add the new element." - - ^ [:set :element | - set remove: (set array at: index) enclosedSetElement. - set add: element]! Item was added: + ----- Method: SetInspector>>fieldList (in category 'accessing') ----- + fieldList + object + ifNil: [^ Set new]. + ^ self baseFieldList + , (object array + withIndexCollect: [:each :i | each ifNotNil: [i printString]]) + select: [:each | each notNil]! Item was removed: - ----- Method: SetInspector>>isElementValid: (in category 'private') ----- - isElementValid: anElement - - ^ anElement notNil! Item was added: + ----- Method: SetInspector>>mainFieldListMenu: (in category 'menu') ----- + mainFieldListMenu: aMenu + + ^ aMenu addTranslatedList: #( + ('inspect' inspectSelection) + ('copy name' copyName) + ('objects pointing to this value' objectReferencesToSelection) + ('refresh view' update) + ('remove' removeSelection) + - + ('basic inspect' inspectBasic)); + yourself + ! Item was added: + ----- Method: SetInspector>>removeSelection (in category 'menu') ----- + removeSelection + (selectionIndex <= object class instSize) ifTrue: [^ self changed: #flash]. + object remove: self selection. + selectionIndex := 0. + self setContents: ''. + self changed: #inspectObject. + self changed: #fieldList. + self changed: #selection. + self changed: #selectionIndex.! Item was changed: + ----- Method: SetInspector>>replaceSelectionValue: (in category 'selecting') ----- - ----- Method: SetInspector>>replaceSelectionValue: (in category 'selection') ----- replaceSelectionValue: anObject + ^ object array at: self arrayIndexForSelection put: anObject! - "After replacing the value, we have to scan for the field that now contains anObject." - - (super replaceSelectionValue: anObject) ifTrue: [ - self updateFields. - self selectFieldSuchThat: [:field | [(field getValueFor: self) == anObject] ifError: [false] ]].! Item was added: + ----- Method: SetInspector>>selection (in category 'selecting') ----- + selection + selectionIndex = 0 ifTrue: [^ '']. + selectionIndex = 1 ifTrue: [^ object]. + selectionIndex = 2 ifTrue: [^ object longPrintString]. + (selectionIndex - 2) <= object class instSize + ifTrue: [^ object instVarAt: selectionIndex - 2]. + + ^ object array at: self arrayIndexForSelection ifAbsent: [ String empty ]! Item was changed: ----- Method: StandardToolSet class>>basicInspect: (in category 'inspecting') ----- basicInspect: anObject + "Open an inspector on the given object. The tool set must know which inspector type to use for which object - the object cannot possibly know what kind of inspectors the toolset provides." + ^BasicInspector openOn: anObject! - "Open a basic inspector on the given object." - ^ BasicInspector openOn: anObject! Item was removed: - ----- Method: StandardToolSet class>>browseMethod: (in category 'browsing') ----- - browseMethod: aCompiledMethod - "Browse aCompiledMethod on the most convenient possible way, using a System Browser, a Versions Browser, or an Inspector." - - aCompiledMethod isInstalled - ifTrue: [^ self browse: aCompiledMethod methodClass selector: aCompiledMethod selector]. - (aCompiledMethod methodClass changeRecordsAt: aCompiledMethod selector) - ifNotNil: [^ self browseMethodVersion: aCompiledMethod]. - ^ self inspect: aCompiledMethod! Item was removed: - ----- Method: StringHolder>>browseClassHierarchy (in category '*Tools') ----- - browseClassHierarchy - "Create and schedule a class list browser on the receiver's hierarchy." - - self systemNavigation - spawnHierarchyForClass: self selectedClassOrMetaClass "OK if nil" - selector: self selectedMessageName! Item was added: + ----- Method: StringHolder>>classHierarchy (in category '*Tools') ----- + classHierarchy + "Create and schedule a class list browser on the receiver's hierarchy." + + self systemNavigation + spawnHierarchyForClass: self selectedClassOrMetaClass "OK if nil" + selector: self selectedMessageName + ! Item was changed: ----- Method: StringHolder>>messageListKey:from: (in category '*Tools') ----- messageListKey: aChar from: view "Respond to a Command key. I am a model with a code pane, and I also have a listView that has a list of methods. The view knows how to get the list and selection." | sel class | aChar == $D ifTrue: [^ self toggleDiffing]. sel := self selectedMessageName. aChar == $m ifTrue: "These next two put up a type in if no message selected" [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation]. aChar == $n ifTrue: [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self systemNavigation]. "The following require a class selection" (class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view]. aChar == $b ifTrue: [^ ToolSet browse: class selector: sel]. aChar == $N ifTrue: [^ self browseClassRefs]. aChar == $i ifTrue: [^ self methodHierarchy]. + aChar == $h ifTrue: [^ self classHierarchy]. - aChar == $h ifTrue: [^ self browseClassHierarchy]. aChar == $p ifTrue: [^ self browseFullProtocol]. "The following require a method selection" sel ifNotNil: [aChar == $o ifTrue: [^ self fileOutMessage]. aChar == $c ifTrue: [^ self copySelector]. aChar == $C ifTrue: [^ self copyReference]. aChar == $v ifTrue: [^ self browseVersions]. aChar == $x ifTrue: [^ self removeMessage]]. ^ self arrowKey: aChar from: view! Item was removed: - ----- Method: ToolIcons class>>cleanUp: (in category 'initialize-release') ----- - cleanUp: aggressive - - aggressive ifTrue: [Icons := nil].! Item was changed: ----- Method: VersionsBrowser class>>browseMethod: (in category 'instance creation') ----- browseMethod: aCompiledMethod + ^ (self browseVersionsForClass: aCompiledMethod methodClass selector: aCompiledMethod selector) + selectMethod: aCompiledMethod; - ^ (self browseVersionsOf: aCompiledMethod) - ifNotNil: [:browser | - browser selectMethod: aCompiledMethod]; yourself! Item was removed: - ----- Method: VersionsBrowser class>>browseVersionsOf: (in category 'instance creation') ----- - browseVersionsOf: aCompiledMethod - - | methodClass methodSelector | - methodClass := aCompiledMethod methodClass. - methodSelector := aCompiledMethod selector. - ^ self - browseVersionsOf: aCompiledMethod - class: methodClass - meta: methodClass isMeta - category: (methodClass organization categoryOfElement: methodSelector) - selector: methodSelector! Item was changed: ----- Method: WeakSet>>inspectorClass (in category '*Tools-Inspector') ----- inspectorClass ^ WeakSetInspector! Item was changed: SetInspector subclass: #WeakSetInspector + instanceVariableNames: 'flagObject' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! !WeakSetInspector commentStamp: '<historical>' prior: 0! A verison of the SetInspector specialized for inspecting WeakSets. It knows about the flag object used to indicate empty locations in the hash table.! Item was added: + ----- Method: WeakSetInspector>>fieldList (in category 'accessing') ----- + fieldList + | slotIndices | + object ifNil: [^ Set new]. + + "Implementation note: do not use objectArray withIndexCollect: as super + because this might collect indices in a WeakArray, leading to constantly changing fieldList + as explained at http://bugs.squeak.org/view.php?id=6812" + + slotIndices := (Array new: object size) writeStream. + object array withIndexDo: [:each :i | + (each notNil and: [each ~= flagObject]) ifTrue: [slotIndices nextPut: i printString]]. + + ^ self baseFieldList + , slotIndices contents! Item was added: + ----- Method: WeakSetInspector>>initialize (in category 'initialize-release') ----- + initialize + super initialize. + flagObject := object instVarNamed: 'flag'. ! Item was removed: - ----- Method: WeakSetInspector>>isElementValid: (in category 'private') ----- - isElementValid: anElement - "Consider the #flag object, which is used to mark GC'ed elements in the WeakSet." - - ^ anElement notNil and: [anElement ~~ (self object instVarNamed: #flag)]! Item was removed: - (PackageInfo named: 'Tools') postscript: '(Smalltalk globals at: #ObjectsUnderInspection ifAbsent: [#()]) - do: [:objectUnderInspection | - ToolSet inspect: objectUnderInspection]. - Smalltalk globals removeKey: #ObjectsUnderInspection.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20200605/f0a4d4e2/attachment-0001.html>
More information about the Squeak-dev mailing list |