'From Squeak3.7beta of ''1 April 2004'' [latest update: #5967] on 8 September 2004 at 11:45:26 am'! "Change Set: InspectorFixes Date: 14 July 2004 Author: Peter Keeler and Andrew Black This changeset provides a specialized inspector for Sets, along the lines of the sepcialized Dictionary- and OrderedCollection inspectors. It also cleans up a lot of code related to the way that inspectors are chosen, created and initialized. InspectorTests now pass. This changeset also updates DictionaryInspector to add the default field list (self, all inst vars, and the instance variables tally and array) ahead of the ""fields"" named by the keys to the dictionary. This change was discussed on the Squeak mailing list, most recently on 13 Aug 2004 at 11:43:20."! Inspector subclass: #SetInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! !SetInspector commentStamp: '' 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 subclass: #WeakSetInspector instanceVariableNames: 'flagObject' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! !WeakSetInspector commentStamp: '' 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.! !Object methodsFor: 'user interface' stamp: 'apb 7/14/2004 13:17'! inspectWithLabel: aLabel ^self inspectorClass openOn: self withEvalPane: true withLabel: aLabel! ! !Object methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:52'! inspect "Create and schedule an Inspector in which the user can examine the receiver's variables." ^self inspectorClass openOn: self withEvalPane: true! ! !Object methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:19'! 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! ! !CompiledMethod methodsFor: 'user interface' stamp: 'apb 7/14/2004 12:18'! 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! ! !CompositeEvent methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:18'! 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! ! !Controller methodsFor: 'view access' stamp: 'apb 7/14/2004 12:50'! inspectView view notNil ifTrue: [^ view inspect; yourself]! ! !ExternalStructure methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:11'! 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." self class fields size > 0 ifTrue: [^ExternalStructureInspector] ifFalse: [^super inspectorClass]! ! !FloatArray methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:18'! 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! ! !Inspector methodsFor: 'selecting' stamp: 'apb 8/20/2004 22:45'! 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]. result == #failedDoit ifTrue: [^ false]. self replaceSelectionValue: result. self changed: #contents. ^ true! ! !Inspector methodsFor: 'selecting' stamp: 'apb 8/20/2004 22:03'! selectionPrintString | text | selectionUpdateTime := [text := [self selection printStringLimitedTo: 5000] on: Error do: [text := self printStringErrorText. text addAttribute: TextColor red from: 1 to: text size. text]] timeToRun. ^ text! ! !Inspector methodsFor: 'selecting' stamp: 'PHK 6/30/2004 11:50'! 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! ! !Inspector methodsFor: 'menu commands' stamp: 'PHK 6/30/2004 11:47'! 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! ! !Inspector methodsFor: 'menu commands' stamp: 'apb 7/14/2004 13:16'! 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! ! !Inspector methodsFor: 'initialize-release' stamp: 'apb 7/14/2004 14:45'! initialize selectionIndex _ 0. super initialize! ! !Inspector methodsFor: 'initialize-release' stamp: 'apb 7/26/2004 16:44'! inspect: anObject "Initialize the receiver so that it is inspecting anObject. There is no current selection. 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." | c | c _ anObject inspectorClass. (self class ~= c and: [self class format = c format]) ifTrue: [ self primitiveChangeClassTo: c basicNew]. "Set 'object' before sending the initialize message, because some implementations of initialize (e.g., in DictionaryInspector) require 'object' to be non-nil." object _ anObject. self initialize! ! !Inspector methodsFor: 'private' stamp: 'apb 8/20/2004 22:05'! printStringErrorText | nm | nm _ self selectionIndex < 3 ifTrue: ['self'] ifFalse: [self selectedSlotName]. ^ ('') asText.! ! !Inspector methodsFor: 'stepping' stamp: 'apb 7/14/2004 14:28'! 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 ]. newText = contents ifFalse: [contents _ newText. self changed: #contents]! ! !ContextVariablesInspector methodsFor: 'accessing' stamp: 'apb 7/26/2004 16:53'! 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: " object _ anObject. self initialize ! ! !DictionaryInspector methodsFor: 'accessing' stamp: 'apb 8/20/2004 23:06'! fieldList ^ self baseFieldList , (keyArray collect: [:key | key printString])! ! !DictionaryInspector methodsFor: 'selecting' stamp: 'apb 8/20/2004 21:41'! 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! ! !DictionaryInspector methodsFor: 'selecting' stamp: 'apb 8/20/2004 23:23'! refreshView | i | i _ selectionIndex. self calculateKeyArray. selectionIndex _ i. self changed: #fieldList. self changed: #contents.! ! !DictionaryInspector methodsFor: 'selecting' stamp: 'apb 8/20/2004 22:37'! replaceSelectionValue: anObject selectionIndex <= self numberOfFixedFields ifTrue: [^ super replaceSelectionValue: anObject]. ^ object at: (keyArray at: selectionIndex - self numberOfFixedFields) put: anObject! ! !DictionaryInspector methodsFor: 'selecting' stamp: 'apb 8/20/2004 21:55'! selection selectionIndex <= (self numberOfFixedFields) ifTrue: [^ super selection]. ^ object at: (keyArray at: selectionIndex - self numberOfFixedFields) ifAbsent:[nil]! ! !DictionaryInspector methodsFor: 'private' stamp: 'apb 8/20/2004 21:15'! numberOfFixedFields ^ 2 + object class instSize! ! !DictionaryInspector methodsFor: 'menu' stamp: 'apb 8/20/2004 21:41'! addEntry | newKey aKey | newKey _ FillInTheBlank 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! ! !DictionaryInspector methodsFor: 'menu' stamp: 'apb 8/20/2004 21:19'! 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"]! ! !DictionaryInspector methodsFor: 'menu' stamp: 'apb 8/20/2004 23:20'! fieldListMenu: aMenu ^ aMenu labels: 'inspect copy name objects pointing to this value senders of this key refresh view add key rename key remove basic inspect' lines: #(5 8) selections: #(inspectSelection copyName objectReferencesToSelection sendersOfSelectedKey refreshView addEntry renameEntry removeSelection inspectBasic) ! ! !DictionaryInspector methodsFor: 'menu' stamp: 'apb 8/20/2004 21:39'! removeSelection selectionIndex = 0 ifTrue: [^ self changed: #flash]. object removeKey: (keyArray at: selectionIndex - self numberOfFixedFields). selectionIndex _ 0. contents _ ''. self calculateKeyArray. self changed: #inspectObject. self changed: #selectionIndex. self changed: #fieldList. self changed: #selection.! ! !DictionaryInspector methodsFor: 'menu' stamp: 'apb 8/20/2004 21:38'! renameEntry | newKey aKey value | value _ object at: (keyArray at: selectionIndex - self numberOfFixedFields). newKey _ FillInTheBlank 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! ! !DictionaryInspector methodsFor: 'menu' stamp: 'apb 8/20/2004 21:30'! 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) isKindOf: Symbol) ifFalse: [^ self changed: #flash]. SystemNavigation default browseAllCallsOn: aKey! ! !DictionaryInspector methodsFor: 'initialize-release' stamp: 'PHK 7/21/2004 18:00'! initialize super initialize. self calculateKeyArray! ! !Inspector class methodsFor: 'instance creation' stamp: 'PHK 7/22/2004 17:04'! 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." ^self basicNew inspect: anObject! ! !Inspector class methodsFor: 'instance creation' stamp: 'apb 7/14/2004 12:54'! openAsMorphOn: anObject withEvalPane: withEval withLabel: label valueViewClass: valueViewClass "Note: for now, this always adds an eval pane, and ignores the valueViewClass" ^ (self openAsMorphOn: anObject withLabel: label) openInWorld! ! !Inspector class methodsFor: 'instance creation' stamp: 'PHK 6/30/2004 10:48'! openAsMorphOn: anObject withLabel: aLabel "(Inspector openAsMorphOn: SystemOrganization) openInMVC" | window inspector | inspector _ self inspect: anObject. window _ (SystemWindow labelled: aLabel) model: inspector. window addMorph: ( PluggableListMorph new doubleClickSelector: #inspectSelection; on: inspector list: #fieldList selected: #selectionIndex changeSelected: #toggleIndex: menu: #fieldListMenu: keystroke: #inspectorKey:from:) frame: (0@0 corner: self horizontalDividerProportion @ self verticalDividerProportion). window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept: readSelection: #contentsSelection menu: #codePaneMenu:shifted:) frame: (self horizontalDividerProportion @0 corner: 1@self verticalDividerProportion). window addMorph: ((PluggableTextMorph on: inspector text: #trash accept: #trash: readSelection: #contentsSelection menu: #codePaneMenu:shifted:) askBeforeDiscardingEdits: false) frame: (0@self verticalDividerProportion corner: 1@1). window setUpdatablePanesFrom: #(fieldList). window position: 16@0. "Room for scroll bar." ^ window! ! !Inspector class methodsFor: 'instance creation' stamp: 'PHK 6/30/2004 10:51'! openOn: anObject withEvalPane: withEval withLabel: label valueViewClass: valueViewClass | topView inspector listView valueView evalView | inspector _ self inspect: anObject. topView _ StandardSystemView new model: inspector. topView borderWidth: 1. listView _ PluggableListView on: inspector list: #fieldList selected: #selectionIndex changeSelected: #toggleIndex: menu: #fieldListMenu: keystroke: #inspectorKey:from:. listView window: (0 @ 0 extent: 40 @ 40). topView addSubView: listView. valueView _ valueViewClass new. "PluggableTextView or PluggableFormView" (valueView respondsTo: #getText) ifTrue: [ valueView on: inspector text: #contents accept: #accept: readSelection: #contentsSelection menu: #codePaneMenu:shifted:]. (valueViewClass inheritsFrom: FormView) ifTrue: [ valueView model: inspector]. valueView window: (0 @ 0 extent: 75 @ 40). topView addSubView: valueView toRightOf: listView. withEval ifTrue: [evalView _ PluggableTextView new on: inspector text: #trash accept: #trash: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. evalView window: (0 @ 0 extent: 115 @ 20). evalView askBeforeDiscardingEdits: false. topView addSubView: evalView below: listView]. topView label: label. topView minimumSize: 180 @ 120. topView setUpdatablePanesFrom: #(fieldList). topView controller open! ! !InspectorBrowser methodsFor: 'initialize-release' stamp: 'apb 7/26/2004 17:34'! initialize super initialize. fieldList _ nil. msgListIndex _ 0. self changed: #msgText ! ! !InspectorBrowser methodsFor: 'initialize-release' stamp: 'apb 7/26/2004 17:34'! 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 initialize ! ! !InspectorBrowser methodsFor: 'messages' stamp: 'apb 7/14/2004 13:50'! msgList msgList ifNotNil: [^ msgList]. ^ (msgList _ object class selectors asSortedArray)! ! !InspectorBrowser methodsFor: 'messages' stamp: 'apb 7/14/2004 13:57'! msgListMenu: aMenu ^ aMenu labels: 'Not yet implemented' lines: #(0) selections: #(flash)! ! !OrderedCollection methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:19'! 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! ! !Set methodsFor: 'as yet unclassified' stamp: 'apb 7/14/2004 12:19'! 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." ^ SetInspector ! ! !Dictionary methodsFor: 'printing' stamp: 'apb 7/14/2004 12:48'! printElementsOn: aStream aStream nextPut: $(. self size > 100 ifTrue: [aStream nextPutAll: 'size '. self size printOn: aStream] ifFalse: [self keysSortedSafely do: [:key | aStream print: key; nextPutAll: '->'; print: (self at: key); space]]. aStream nextPut: $)! ! !Dictionary methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:18'! 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." ^ DictionaryInspector! ! !SetInspector methodsFor: 'menu' stamp: 'PHK 6/30/2004 12:16'! fieldListMenu: aMenu ^ aMenu labels: 'inspect copy name objects pointing to this value refresh view remove basic inspect' lines: #( 5 8) selections: #(inspectSelection copyName objectReferencesToSelection update removeSelection inspectBasic) ! ! !SetInspector methodsFor: 'menu' stamp: 'PHK 6/30/2004 12:29'! removeSelection (selectionIndex <= object class instSize) ifTrue: [^ self changed: #flash]. object remove: self selection. selectionIndex _ 0. contents _ ''. self changed: #inspectObject. self changed: #fieldList. self changed: #selection. self changed: #selectionIndex.! ! !SetInspector methodsFor: 'menu commands' stamp: 'PHK 6/30/2004 12:25'! 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]! ! !SetInspector methodsFor: 'accessing' stamp: 'PHK 6/29/2004 14:50'! fieldList object ifNil: [^ Set new]. ^ self baseFieldList , (object array withIndexCollect: [:each :i | each ifNotNil: [i printString]]) select: [:each | each notNil]! ! !SetInspector methodsFor: 'selecting' stamp: 'PHK 6/29/2004 15:33'! arrayIndexForSelection ^ (self fieldList at: selectionIndex) asInteger! ! !SetInspector methodsFor: 'selecting' stamp: 'PHK 6/29/2004 15:38'! replaceSelectionValue: anObject ^ object array at: self arrayIndexForSelection put: anObject! ! !SetInspector methodsFor: 'selecting' stamp: 'PHK 6/29/2004 15:35'! 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! ! !WeakSet methodsFor: 'inspecting' stamp: 'apb 8/20/2004 23:48'! inspectorClass ^ WeakSetInspector ! ! !WeakSetInspector methodsFor: 'accessing' stamp: 'apb 8/21/2004 02:46'! fieldList object ifNil: [^ Set new]. ^ self baseFieldList , (object array withIndexCollect: [:each :i | (each notNil and: [each ~= flagObject]) ifTrue: [i printString]]) select: [:each | each notNil]! ! !WeakSetInspector methodsFor: 'initialize-release' stamp: 'apb 8/21/2004 02:44'! initialize super initialize. flagObject _ object instVarNamed: 'flag'. ! ! Dictionary removeSelector: #inspect! Dictionary removeSelector: #inspectWithLabel:! OrderedCollection removeSelector: #inspect! DictionaryInspector removeSelector: #dictionaryMenu:! DictionaryInspector removeSelector: #inspect:! DictionaryInspector removeSelector: #selectionReferences! DictionaryInspector removeSelector: #selectionUnmodifiable! !DictionaryInspector reorganize! ('accessing' fieldList) ('selecting' addEntry: calculateKeyArray contentsIsString refreshView replaceSelectionValue: selection) ('private' numberOfFixedFields) ('menu' addEntry copyName fieldListMenu: removeSelection renameEntry sendersOfSelectedKey) ('initialize-release' initialize) ! FloatArray removeSelector: #inspect! FloatArray removeSelector: #inspectWithLabel:! ExternalStructure removeSelector: #inspect! CompositeEvent removeSelector: #inspect! CompositeEvent removeSelector: #inspectWithLabel:!