Packages April 2020

packages@lists.squeakfoundation.org

1 participants
67 discussions

The Trunk: Tools-mt.965.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.965.mcz ==================== Summary ==================== Name: Tools-mt.965 Author: mt Time: 27 April 2020, 10:20:48.85934 am UUID: b6455463-508c-264d-8def-8dc1c7f9feb5 Ancestors: Tools-mt.964 Inspector refactoring. See: http://forum.world.st/Please-try-out-Inspector-Refactoring-tp5114974.html =============== Diff against Tools-mt.964 =============== Item was added: + (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 added: + ----- Method: Bag>>inspectorClass (in category '*Tools-Inspector') ----- + inspectorClass + + ^ BagInspector! Item was added: + 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 added: + ----- Method: BagInspector>>addElement: (in category 'menu commands') ----- + addElement: anObject + + self object add: anObject. + self updateFields. + self selectElementAt: anObject.! Item was added: + ----- 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 added: + ----- Method: BagInspector>>elementIndices (in category 'initialization') ----- + elementIndices + + ^ [ (object instVarNamed: #contents) keysInOrder ] ifError: [ + "Can occur when debugging Bag new" + Array empty ].! Item was added: + ----- 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 added: + ----- Method: BagInspector>>isBindingSelected (in category 'bindings') ----- + isBindingSelected + + ^ false! Item was added: + ----- 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 added: + ----- Method: BasicInspector class>>openOn:withLabel: (in category 'as yet unclassified') ----- + openOn: anObject withLabel: label + "Ignore label." + + ^ ToolBuilder open: (self on: anObject)! Item was added: + ----- Method: BasicInspector>>basicObjectPrintString (in category 'initialization') ----- + basicObjectPrintString + + ^ 'a {1}({2})' format: {thisContext objectClass: object. object identityHash}! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 'initialization') ----- - ----- Method: BasicInspector>>inspect: (in category 'initialize-release') ----- inspect: anObject + "We don't want to change the inspector class. Only set anObject as the inspectee." + self object: anObject! - "Initialize the receiver so that it is inspecting anObject. There is no - current selection." - - self initialize. - object := anObject. - selectionIndex := 0. - contents := ''! Item was added: + ----- Method: BasicInspector>>labelString (in category 'initialization') ----- + labelString + + ^ '{1} {2}{3}' format: { + '[basic]'. + self basicObjectPrintString. + (self object isReadOnlyObject + ifTrue: [' (read-only)'] + ifFalse: [''])}! Item was added: + ----- Method: BasicInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- + streamBaseFieldsOn: aStream + + aStream + nextPut: self fieldSelf; + nextPut: self fieldObjectClass; + nextPut: self fieldObjectSize.! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: Bitset>>inspectorClass (in category '*Tools-Inspector') ----- + inspectorClass + + ^ BitsetInspector! Item was added: + 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 added: + ----- 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 added: + ----- Method: BitsetInspector>>elementIndices (in category 'private') ----- + elementIndices + + ^ 0 to: self objectSize - 1! Item was added: + ----- 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 added: + ----- Method: BitsetInspector>>objectSize (in category 'private') ----- + objectSize + + ^ self object capacity! Item was added: + ----- Method: BitsetInspector>>removeSelectedElement (in category 'menu - commands') ----- + removeSelectedElement + "Flip the selected bit back to 0." + + self selectedField setValueFor: self to: 0.! Item was added: + ----- Method: BitsetInspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- + streamBaseFieldsOn: aStream + + super streamBaseFieldsOn: aStream. + aStream nextPut: self fieldSize.! Item was added: + ----- Method: Class>>inspectorClass (in category '*Tools-Inspector') ----- + inspectorClass + + ^ ClassInspector! Item was added: + 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: Collection>>inspectorClass (in category '*Tools-Inspector') ----- + inspectorClass + + ^ CollectionInspector! Item was added: + 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 added: + ----- 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 added: + ----- Method: CollectionInspector>>addElement (in category 'menu - commands') ----- + addElement + + self addElement: ( + self + requestObject: 'Enter expression for new object' translated + orCancel: [^ self]).! Item was added: + ----- 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 added: + ----- Method: CollectionInspector>>assertElementSelectedOr: (in category 'private') ----- + assertElementSelectedOr: aBlock + + ^ self typeOfSelection = #element + or: [aBlock cull: self selectedField]! Item was added: + ----- 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 added: + ----- Method: CollectionInspector>>elementGetterAt: (in category 'private') ----- + elementGetterAt: index + + ^ [:collection | collection at: index] ! Item was added: + ----- Method: CollectionInspector>>elementIndices (in category 'private') ----- + elementIndices + + ^ 1 to: self objectSize! Item was added: + ----- Method: CollectionInspector>>elementSetterAt: (in category 'private') ----- + elementSetterAt: index + + ^ [:collection :element | collection at: index put: element] ! Item was added: + ----- Method: CollectionInspector>>inspectOne (in category 'menu - commands') ----- + inspectOne + "Only list the collection's elements. Ignore any other fields." + + self inspectOneOf: self elementIndices.! Item was added: + ----- Method: CollectionInspector>>inspectorKey:from: (in category 'menu') ----- + inspectorKey: aChar from: view + + ^ aChar = $x + ifTrue: [self removeSelection] + ifFalse: [super inspectorKey: aChar from: view].! Item was added: + ----- 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 added: + ----- Method: CollectionInspector>>removeSelectedElement (in category 'menu - commands') ----- + removeSelectedElement + + self object remove: self selection.! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: CollectionInspector>>requestObject:orCancel: (in category 'ui requests') ----- + requestObject: aMessageString orCancel: aBlock + + ^ self + requestObject: aMessageString + initialAnswer: String empty + orCancel: aBlock! Item was added: + ----- Method: CollectionInspector>>selectElementAt: (in category 'selection') ----- + selectElementAt: index + + self selectFieldSuchThat: [:field | field type = #element and: [field key = index]].! Item was added: + ----- Method: CollectionInspector>>selectedElementIndex (in category 'selection') ----- + selectedElementIndex + + self assertElementSelectedOr: [^ nil]. + ^ self selectedField key! Item was added: + ----- 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 added: + ----- 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." + ^ CompiledCodeInspector! - ^ CompiledMethodInspector! Item was added: + 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: CompiledCodeInspector>>fieldHeader (in category 'fields') ----- + fieldHeader + + ^ (self newFieldForType: #misc key: #header) + name: 'header' translated; emphasizeName; + valueGetter: [:object | object headerDescription]; printValueAsIs; + yourself! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 removed: - ----- 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 removed: - Inspector subclass: #CompiledMethodInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! Item was removed: - ----- Method: CompiledMethodInspector>>contentsIsString (in category 'selecting') ----- - contentsIsString - "Hacked so contents empty when deselected" - - ^ #(0 2 3) includes: selectionIndex! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 added: + ----- 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 removed: - ----- 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 removed: - ----- 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 added: + ----- 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 added: + ----- Method: ContextInspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- + streamIndexedVariablesOn: aStream + "Just show (indexed) stack variables to the list." + + self streamStackVariablesOn: aStream.! Item was added: + ----- Method: ContextInspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- + streamInstanceVariablesOn: aStream + "Add (named) temporary variables to the list." + + super streamInstanceVariablesOn: aStream. + self streamTemporaryVariablesOn: aStream.! Item was added: + ----- 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 added: + ----- 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: + ContextInspector subclass: #ContextVariablesInspector + instanceVariableNames: '' + classVariableNames: 'ShowStackVariables' - Inspector subclass: #ContextVariablesInspector - instanceVariableNames: 'fieldList' - classVariableNames: '' poolDictionaries: '' category: 'Tools-Debugger'! + !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.! - !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.! Item was added: + ----- 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 added: + ----- Method: ContextVariablesInspector class>>showStackVariables: (in category 'preferences') ----- + showStackVariables: aBoolean + + ShowStackVariables := aBoolean.! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 added: + ----- 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 added: + ----- 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 removed: - ----- 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 added: + ----- Method: ContextVariablesInspector>>fieldSelf (in category 'fields') ----- + fieldSelf + + ^ super fieldSelf + name: 'thisContext'; + yourself! Item was added: + ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 added: + ----- 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 added: + ----- Method: ContextVariablesInspector>>streamIndexedVariablesOn: (in category 'fields - streaming') ----- + streamIndexedVariablesOn: aStream + + self class showStackVariables ifTrue: [ + self streamStackVariablesOn: aStream].! Item was added: + ----- 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 added: + ----- 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 removed: - ----- 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 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 | - | isNewMethod selectedContextSlotName | self saveReceiverInspectorState. self saveContextVariablesInspectorState. contextStackIndex := anInteger. anInteger = 0 ifTrue: [currentCompiledMethod := contents := nil. self changed: #contextStackIndex. self decorateButtons. self contentsChanged. contextVariablesInspector object: nil. + receiverInspector context: nil; inspect: self receiver. - receiverInspector object: self receiver. ^self]. + isNewMethod := oldContext isNil + or: [oldContext method ~~ (currentCompiledMethod := self selectedContext method)]. - selectedContextSlotName := contextVariablesInspector selectedFieldName. - isNewMethod := oldContext == nil - 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 context: self selectedContext; inspect: self receiver. - receiverInspector object: 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 on: nil. + contextVariablesInspector := ContextVariablesInspector on: nil. - receiverInspector := Inspector inspect: nil. - contextVariablesInspector := ContextVariablesInspector inspect: nil. self toggleContextStackIndex: oldIndex.! Item was removed: - ----- 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: + CollectionInspector subclass: #DictionaryInspector + instanceVariableNames: '' - Inspector subclass: #DictionaryInspector - instanceVariableNames: 'keyArray' 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 added: + ----- Method: DictionaryInspector>>addElement (in category 'menu - commands') ----- + addElement + + self addElement: (self requestKeyOrCancel: [^ self]).! Item was added: + ----- 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 removed: - ----- 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 removed: - ----- 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 added: + ----- 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 removed: - ----- 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 added: + ----- 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 removed: - ----- Method: DictionaryInspector>>contentsIsString (in category 'selecting') ----- - contentsIsString - "Hacked so contents empty when deselected" - - ^ (selectionIndex = 0)! Item was removed: - ----- 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 added: + ----- Method: DictionaryInspector>>elementIndices (in category 'private') ----- + elementIndices + + ^ [ self object keysInOrder ] ifError: [ + "Can occur when debugging Dictionary new" + Array empty]! Item was removed: - ----- Method: DictionaryInspector>>fieldList (in category 'accessing') ----- - fieldList - ^ self baseFieldList - , (keyArray collect: [:key | key printString])! Item was removed: - ----- 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." + self assertElementSelectedOr: [^ self]. + self selectedKey inspect.! - selectionIndex >= self numberOfFixedFields ifTrue: - [(keyArray at: selectionIndex - self numberOfFixedFields) inspect]! Item was added: + ----- 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 removed: - ----- 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 removed: - ----- Method: DictionaryInspector>>numberOfFixedFields (in category 'private') ----- - numberOfFixedFields - ^ 2 + object class instSize! Item was removed: - ----- Method: DictionaryInspector>>refreshView (in category 'selecting') ----- - refreshView - | i | - i := selectionIndex. - self calculateKeyArray. - selectionIndex := i. - self changed: #fieldList. - self changed: #contents.! Item was added: + ----- Method: DictionaryInspector>>removeSelectedElement (in category 'menu - commands') ----- + removeSelectedElement + + self object removeKey: self selectedKey.! Item was removed: - ----- 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 removed: - ----- 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 added: + ----- Method: DictionaryInspector>>renameKey (in category 'menu - commands') ----- + renameKey + + self assertElementSelectedOr: [^ self changed: #flash]. + self renameKey: ( + self + requestKeyInitialAnswer: self selectedKey storeString + orCancel: [^ self]).! Item was added: + ----- 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 removed: - ----- 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 added: + ----- 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 added: + ----- Method: DictionaryInspector>>requestKeyOrCancel: (in category 'ui requests') ----- + requestKeyOrCancel: aBlock + + ^ self + requestKeyInitialAnswer: String empty + orCancel: aBlock! Item was added: + ----- 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 added: + ----- Method: DictionaryInspector>>selectedBinding (in category 'bindings') ----- + selectedBinding + + ^ self selectedKey + ifNotNil: [:key | self object associationAt: key]! Item was added: + ----- Method: DictionaryInspector>>selectedKey (in category 'selection') ----- + selectedKey + "Overriden to make clear that a dictionary's indices are called 'keys'." + + ^ self selectedElementIndex! Item was removed: - ----- Method: DictionaryInspector>>selection (in category 'selecting') ----- - selection - - selectionIndex <= (self numberOfFixedFields) ifTrue: [^ super selection]. - ^ object at: (keyArray at: selectionIndex - self numberOfFixedFields) ifAbsent:[nil]! Item was removed: - ----- 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 - commands') ----- - ----- Method: DictionaryInspector>>sendersOfSelectedKey (in category 'menu') ----- sendersOfSelectedKey "Create a browser on all senders of the selected key" + | aKey | + ((aKey := self selectedKey) isSymbol) - self selectionIndex = 0 - ifTrue: [^ self changed: #flash]. - ((aKey := keyArray at: selectionIndex - self numberOfFixedFields) isSymbol) ifFalse: [^ self changed: #flash]. + self systemNavigation browseAllCallsOn: aKey! - SystemNavigation default browseAllCallsOn: aKey! Item was added: + ----- 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 removed: - ----- 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-Inspector') ----- - ----- Method: FutureMaker>>defaultLabelForInspector (in category '*Tools-inspecting') ----- 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-Inspector') ----- - ----- Method: FutureMaker>>inspectorClass (in category '*Tools-inspecting') ----- 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 context fields customFields selectionIndex expression contentsTyped fieldListStyler shouldStyleValuePane selectionUpdateTime' - instanceVariableNames: 'object selectionIndex timeOfLastListUpdate selectionUpdateTime context expression shouldStyleValuePane contentsTyped' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! + !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".)! - !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.! Item was changed: ----- Method: Inspector class>>inspect: (in category 'instance creation') ----- inspect: anObject + "Answer a new (sub)instance of me to provide an inspector for 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 new inspect: anObject! - ^self basicNew inspect: anObject! Item was added: + ----- 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 + "Open an inspector for anObject." + + ^ ToolBuilder open: (self on: anObject)! - "Create and schedule an instance of me on the model, anInspector. " - - ^ self openOn: anObject withLabel: anObject defaultLabelForInspector! 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 on: anObject) label: label! - ^ ToolBuilder open: (self inspect: anObject) label: label! Item was changed: + ----- Method: Inspector>>aboutToStyle:requestor: (in category 'user interface - styling') ----- - ----- Method: Inspector>>aboutToStyle:requestor: (in category 'styling') ----- aboutToStyle: aStyler requestor: anObject + "We have two text fields in this tool: code pane and value pane. Do always style the code pane." - - (anObject knownName = #valuePane and: [shouldStyleValuePane not]) - ifTrue: [^ false]. + 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]]]! - aStyler - classOrMetaClass: object class; - parseAMethod: false. - ^true! Item was removed: - ----- 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 added: + ----- 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 - construction') ----- - ----- Method: Inspector>>addCollectionItemsTo: (in category 'menu commands') ----- addCollectionItemsTo: aMenu - "If the current selection is an appropriate collection, add items to aMenu that cater to that kind of selection" + aMenu + add: 'inspect element...' translated + target: self + selector: #inspectOne.! - | 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))].! Item was added: + ----- Method: Inspector>>addCustomField (in category 'fields - custom') ----- + addCustomField + + ^ self addCustomField: (self requestCustomFieldOrCancel: [^ self])! Item was added: + ----- Method: Inspector>>addCustomField: (in category 'fields - custom') ----- + addCustomField: aField + + aField type: #custom. + self customFields add: aField. + self updateFields. + self selectField: aField.! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: Inspector>>addInstVarItemsTo: (in category 'menu - construction') ----- + addInstVarItemsTo: aMenu + + aMenu addTranslatedList: #( + - + ('references (r)' browseVariableReferences) + ('assignments (a)' browseVariableAssignments)).! Item was added: + ----- 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 added: + ----- Method: Inspector>>applyUserInterfaceTheme (in category 'user interface') ----- + applyUserInterfaceTheme + + super applyUserInterfaceTheme. + + self fieldListStyler ifNotNil: [:styler | + styler reset. + self updateFieldList].! Item was removed: - ----- 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 classOfSelection! - ToolSet browseClass: self selectedClass! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 + "Overridden. Note that I do not hold #contents in my code pane. See my value pane for that." + + ^ builder pluggableCodePaneSpec new - | textSpec | - textSpec := builder pluggableCodePaneSpec new. - textSpec model: self; getText: #expression; editText: #expression:; + help: 'Evaluate expressions on inspected object' translated; - help: #helpText; - selection: #contentsSelection; menu: #codePaneMenu:shifted:; + askBeforeDiscardingEdits: false; + yourself! - askBeforeDiscardingEdits: false. - ^textSpec! Item was changed: ----- Method: Inspector>>buildExploreButtonWith: (in category 'toolbuilder') ----- buildExploreButtonWith: builder ^ builder pluggableButtonSpec new model: self; + label: 'explore' translated; + action: #replaceInspectorWithExplorer; + help: 'Switch to an explorer tool' translated; + yourself! - label: 'explore'; - action: #exploreObject; - help: 'Switch to an explorer tool'! Item was changed: ----- Method: Inspector>>buildFieldListWith: (in category 'toolbuilder') ----- buildFieldListWith: builder + ^ builder pluggableListSpec new - | listSpec | - listSpec := builder pluggableListSpec new. - listSpec model: self; + list: #fieldList; + getIndex: #selectionIndex; + setIndex: #selectionIndex:; + autoDeselect: true; + menu: #fieldListMenu:shifted:; - list: #fieldList; - getIndex: #selectionIndex; - setIndex: #toggleIndex:; - menu: #fieldListMenu:; dragItem: #dragFromFieldList:; + dropItem: #dropOnFieldList:at:shouldCopy:; + keyPress: #inspectorKey:from:; + yourself! - dropItem: #dropOnFieldList:at:; - dropAccept: #wantsDropOnFieldList:type:source:; - keyPress: #inspectorKey:from:. - ^listSpec! Item was changed: ----- Method: Inspector>>buildValuePaneWith: (in category 'toolbuilder') ----- buildValuePaneWith: builder + "The value pane holds this StringHolder's contents." + + ^ builder pluggableCodePaneSpec new - | textSpec | - textSpec := builder pluggableCodePaneSpec new. - textSpec model: self; name: #valuePane; + 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! - getText: #contents; - setText: #accept:; - editText: #typeValue:; - help: 'Selection details.'; - selection: #contentsSelection; - menu: #codePaneMenu:shifted:. - ^textSpec! Item was changed: ----- Method: Inspector>>buildWith: (in category 'toolbuilder') ----- buildWith: builder "Inspector openOn: SystemOrganization" - | windowSpec specs buttonOffset | - buttonOffset := (Preferences standardButtonFont widthOfString: 'explore') * 3/2. + | windowSpec buttonOffset | + buttonOffset := (Preferences standardButtonFont widthOfString: 'explore') * 3/2. + windowSpec := self buildWindowWith: builder specs: { + (0@0 corner: 0.3(a)0.71) + -> [self buildFieldListWith: builder]. + (0.3(a)0.0 corner: 1(a)0.71) + -> [self buildValuePaneWith: builder]. + (LayoutFrame fractions: (0(a)0.71 corner: 1@1) offsets: (0@0 corner: buttonOffset negated@0)) + -> [self buildCodePaneWith: builder]. + (LayoutFrame fractions: (1(a)0.71 corner: 1@1) offsets: (buttonOffset negated@0 corner: 0 @ 0)) + -> [self buildExploreButtonWith: builder]. - specs := { - (0@0 corner: 0.3(a)0.71) -> [self buildFieldListWith: builder]. - (0.3(a)0.0corner: 1(a)0.71) -> [self buildValuePaneWith: builder]. - (LayoutFrame fractions: (0(a)0.71 corner: 1@1) offsets: (0@0 corner: buttonOffset negated@0)) -> [self buildCodePaneWith: builder]. - (LayoutFrame fractions: (1(a)0.71 corner: 1@1) offsets: (buttonOffset negated@0 corner: 0 @ 0)) -> [self buildExploreButtonWith: builder] }. + ^ builder build: windowSpec! - - windowSpec := self buildWindowWith: builder specs: specs. - windowSpec extent: self initialExtent. - ^builder build: windowSpec! Item was removed: - ----- 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 added: + ----- 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 'selection - convenience') ----- - ----- Method: Inspector>>classOfSelection (in category 'menu commands') ----- classOfSelection "Answer the class of the receiver's current selection" + ^ self selectionOrObject class! - self selectionUnmodifiable ifTrue: [^ object class]. - ^ self selection class! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 removed: - ----- 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 - contents') ----- - ----- Method: Inspector>>contentsTyped (in category 'accessing') ----- contentsTyped ^ contentsTyped! Item was changed: + ----- Method: Inspector>>contentsTyped: (in category 'accessing - contents') ----- - ----- Method: Inspector>>contentsTyped: (in category 'accessing') ----- contentsTyped: aStringOrText contentsTyped := aStringOrText.! Item was added: + ----- Method: Inspector>>context (in category 'accessing') ----- + context + + ^ context! Item was changed: ----- Method: Inspector>>context: (in category 'accessing') ----- context: ctxt + "Set the context of inspection, which is used for syntax highlighting and code evaluation." - "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" + context := ctxt.! - context := ctxt! Item was removed: - ----- Method: Inspector>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - timeOfLastListUpdate ifNil: [timeOfLastListUpdate := 0]. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was added: + ----- 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 selected field into clipboard." + + self selectedFieldName + ifNil: [self error: 'Cannot determine field name.' translated] + ifNotNil: [:name | Clipboard clipboardText: name].! - "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! Item was added: + ----- Method: Inspector>>customFields (in category 'accessing') ----- + customFields + + ^ customFields! Item was removed: - ----- 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 removed: - ----- 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 added: + ----- 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 'accessing') ----- - ----- Method: Inspector>>doItReceiver (in category 'code') ----- 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." + ^ self object! - ^object! Item was changed: + ----- Method: Inspector>>dragFromFieldList: (in category 'fields - drag and drop') ----- - ----- Method: Inspector>>dragFromFieldList: (in category 'drag-drop') ----- dragFromFieldList: index + + ^ (self fields at: index ifAbsent: [nil]) + ifNotNil: [:fieldToDrag | fieldToDrag rememberInspector]! - selectionIndex = index ifFalse: [self toggleIndex: index]. - ^self selection! Item was removed: - ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: Inspector>>emphasizeError: (in category 'fields - error handling') ----- + emphasizeError: errorMessage + + ^ ('<{1}>' asText format: { errorMessage }) + addAttribute: self textColorForError; + yourself! Item was added: + ----- 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 removed: - ----- 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 removed: - ----- 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 selectionOrObject explore! - self selectionIndex = 0 ifTrue: [^ self changed: #flash]. - ^ self selection explore! Item was added: + ----- Method: Inspector>>exploreSelectionPointers (in category 'menu - commands') ----- + exploreSelectionPointers + + ^ self selectionOrObject explorePointers! Item was changed: + ----- Method: Inspector>>expression (in category 'accessing - contents') ----- - ----- Method: Inspector>>expression (in category 'accessing') ----- 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 - contents') ----- + expression: aStringOrText + "The code string in the code pane. Recorded for Inspector/Explorer switching. See #replaceInspectorWithExplorer." - ----- Method: Inspector>>expression: (in category 'accessing') ----- - expression: aString + expression := aStringOrText.! - expression := aString.! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: Inspector>>fieldClass (in category 'initialization') ----- + fieldClass + + ^ InspectorField! Item was changed: + ----- Method: Inspector>>fieldList (in category 'user interface') ----- - ----- Method: Inspector>>fieldList (in category 'accessing') ----- fieldList + "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]]]! - "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]])! Item was changed: + ----- Method: Inspector>>fieldListMenu: (in category 'menu') ----- - ----- Method: Inspector>>fieldListMenu: (in category 'menu commands') ----- fieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" ^ self menu: aMenu for: #(fieldListMenu fieldListMenuShifted:) ! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: Inspector>>fields (in category 'accessing') ----- + fields + + ^ fields ifNil: [#()]! Item was added: + ----- 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 added: + ----- Method: Inspector>>hasCustomFields (in category 'fields - custom') ----- + hasCustomFields + + ^ self customFields notEmpty! Item was added: + ----- 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 removed: - ----- Method: Inspector>>helpText (in category 'accessing') ----- - helpText - ^ 'evaluate expressions here'! Item was removed: - ----- 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 removed: - ----- 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 'initialization') ----- - ----- Method: Inspector>>initialExtent (in category 'accessing') ----- 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 'initialization') ----- - ----- Method: Inspector>>initialize (in category 'initialize-release') ----- initialize + + super initialize. + customFields := OrderedCollection new. selectionIndex := 0. + + fieldListStyler := (Smalltalk classNamed: 'SHTextStylerST80') + ifNotNil: [:class | class new].! - shouldStyleValuePane := true. - super initialize! Item was changed: + ----- Method: Inspector>>inspect: (in category 'initialization') ----- - ----- Method: Inspector>>inspect: (in category 'initialize-release') ----- inspect: anObject + "Reinitialize the receiver so that it is inspecting anObject. Become an instance of the appropriate inspectorClass. - "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 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." - 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." + | inspectorClass | + inspectorClass := anObject inspectorClass. + self class ~= inspectorClass ifTrue: [ + self class format = inspectorClass format + ifTrue: [self primitiveChangeClassTo: inspectorClass basicNew] + ifFalse: [self becomeForward: (self as: inspectorClass)]]. - | 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." + self object: anObject.! - object := anObject. - self initialize! Item was removed: - ----- Method: Inspector>>inspectBasic (in category 'menu commands') ----- - inspectBasic - "Bring up a non-special inspector" - - selectionIndex = 0 ifTrue: [^ object basicInspect]. - self selection basicInspect! Item was removed: - ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 hasSelection ifFalse: [^ self changed: #flash]. + ^ self selectionOrObject inspect! - self selectionIndex = 0 ifTrue: [^ self changed: #flash]. - self selection inspect. - ^ self selection! Item was added: + ----- 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') ----- - ----- Method: Inspector>>inspectorKey:from: (in category 'menu commands') ----- inspectorKey: aChar from: view "Respond to a Command key issued while the cursor is over my field list" + ^ 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]! - aChar == $i ifTrue: [^ self selection inspect]. - aChar == $I ifTrue: [^ self selection explore]. - aChar == $b ifTrue: [^ self browseClass]. - aChar == $h ifTrue: [^ self browseClassHierarchy]. - 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! Item was added: + ----- 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') ----- - ----- Method: Inspector>>mainFieldListMenu: (in category 'menu commands') ----- 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]. + self typeOfSelection = #instVar + ifTrue: [self addInstVarItemsTo: aMenu]. - aMenu addList: #( - ('inspect (i)' inspectSelection) - ('explore (I)' exploreSelection)). + 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]. - self addCollectionItemsTo: aMenu. + ^ 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)' browseClassHierarchy) - ('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)" - - ! Item was added: + ----- 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 'updating - steps') ----- - ----- Method: Inspector>>modelWakeUpIn: (in category 'accessing') ----- modelWakeUpIn: aWindow + + self updateFields.! - | 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.! Item was added: + ----- Method: Inspector>>newCustomField (in category 'fields - custom') ----- + newCustomField + + ^ (self newFieldForType: #custom) + valueGetterExpression: 'self yourself'; + yourself! Item was added: + ----- Method: Inspector>>newFieldForType: (in category 'fields') ----- + newFieldForType: aSymbol + + ^ self fieldClass type: aSymbol! Item was added: + ----- 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 'selection') ----- - ----- Method: Inspector>>noteSelectionIndex:for: (in category 'accessing') ----- noteSelectionIndex: anInteger for: aSymbol + + self flag: #mvcOnly. + aSymbol == #fieldList ifTrue: + [selectionIndex := anInteger].! - 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. The current contents, including edits, in the value pane become void because the new object is likely to have new fields with different contents." - object: anObject - "Set anObject to be the object being inspected by the receiver." + self object == anObject ifTrue: [^ self]. + self resetContents. + + object := anObject. + self changed: #object. + + self changed: #windowTitle. + + self updateFields.! - | 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]! 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 object." - "Open a list inspector on all the objects that point to the value of the selected instance variable, if any. " + ^ self systemNavigation + browseAllObjectReferencesTo: self selectionOrObject + except: (Array with: self with: self object) + ifNone: [:obj | self changed: #flash]! - self selectionIndex = 0 ifTrue: [^ self changed: #flash]. - self systemNavigation - browseAllObjectReferencesTo: self selection - except: (Array with: self object) - ifNone: [:obj | self changed: #flash]. - ! Item was added: + ----- Method: Inspector>>okToClose (in category 'user interface - window') ----- + okToClose + + ^ super okToClose and: [self okToDiscardCustomFields]! Item was added: + ----- 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 removed: - ----- 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 removed: - ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 'selection') ----- - ----- Method: Inspector>>replaceSelectionValue: (in category 'selecting') ----- replaceSelectionValue: 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! - "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]! Item was changed: + ----- Method: Inspector>>representsSameBrowseeAs: (in category 'user interface') ----- - ----- Method: Inspector>>representsSameBrowseeAs: (in category 'morphic ui') ----- representsSameBrowseeAs: anotherInspector + ^ self object == anotherInspector object! Item was added: + ----- Method: Inspector>>requestCustomFieldOrCancel: (in category 'fields - custom') ----- + requestCustomFieldOrCancel: aBlock + + ^ self newCustomField + requestCustomFor: self + orCancel: aBlock! Item was added: + ----- Method: Inspector>>resetContents (in category 'initialization') ----- + resetContents + + self setContents: nil.! Item was added: + ----- 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 added: + ----- Method: Inspector>>selectField: (in category 'selection') ----- + selectField: aField + + self selectionIndex: (self fields indexOf: aField ifAbsent: [0])! Item was changed: + ----- Method: Inspector>>selectFieldNamed: (in category 'selection') ----- - ----- Method: Inspector>>selectFieldNamed: (in category 'selecting') ----- selectFieldNamed: aString + "Select the field that is labeled aFieldName, or nothing, is there is no match." + self selectFieldSuchThat: [:field | field name = aString].! - self selectedFieldName = aString ifTrue: [^ self]. - self toggleIndex: (self fieldList indexOf: aString).! Item was added: + ----- 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 'selection - convenience') ----- - ----- Method: Inspector>>selectedClass (in category 'accessing') ----- selectedClass - "Answer the class of the receiver's current selection" + ^ self object class! - self selectionUnmodifiable ifTrue: [^ object class]. - ^ self selection class! Item was added: + ----- Method: Inspector>>selectedField (in category 'selection') ----- + selectedField + + ^ self fields + at: self selectionIndex + ifAbsent: [nil]! Item was changed: + ----- Method: Inspector>>selectedFieldName (in category 'selection') ----- - ----- Method: Inspector>>selectedFieldName (in category 'selecting') ----- selectedFieldName + ^ self selectedField ifNotNil: [:field | field name]! - ^ self fieldList at: self selectionIndex ifAbsent: []! Item was added: + ----- 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 'selection') ----- - ----- Method: Inspector>>selection (in category 'selecting') ----- selection + "Answer the value of the selected variable slot, that is an object." + + ^ self selectedField getValueFor: self! - "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]! Item was changed: + ----- Method: Inspector>>selectionIndex (in category 'accessing') ----- - ----- Method: Inspector>>selectionIndex (in category 'selecting') ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 removed: - ----- 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 removed: - ----- 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 'initialization') ----- - ----- Method: Inspector>>setContents: (in category 'initialize-release') ----- 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 'initialization') ----- - ----- Method: Inspector>>setContentsTyped: (in category 'initialize-release') ----- setContentsTyped: aStringOrText "Simulate typing." + shouldStyleValuePane := true. self contentsTyped: aStringOrText. + + self flag: #refactor. "mt: #changed: is not able to specify the receiver ..." + self valuePane ifNotNil: [:pane | + pane update: #editString with: aStringOrText].! - self changed: #editString with: aStringOrText.! Item was changed: + ----- Method: Inspector>>setExpression: (in category 'initialization') ----- - ----- Method: Inspector>>setExpression: (in category 'code') ----- 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 'updating - steps') ----- - ----- Method: Inspector>>stepAt:in: (in category 'stepping') ----- stepAt: millisecondClockValue in: aWindow - | newText | + self updateFields.! - (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.! Item was changed: + ----- 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." + - ----- Method: Inspector>>stepTimeIn: (in category 'accessing') ----- - stepTimeIn: aSystemWindow ^ (selectionUpdateTime ifNil: [0]) * 10 max: 1000! Item was added: + ----- Method: Inspector>>streamBaseFieldsOn: (in category 'fields - streaming') ----- + streamBaseFieldsOn: aStream + + aStream + nextPut: self fieldSelf; + nextPut: self fieldAllInstVars.! Item was added: + ----- Method: Inspector>>streamCustomFieldsOn: (in category 'fields - streaming') ----- + streamCustomFieldsOn: aStream + + aStream nextPutAll: self customFields.! Item was added: + ----- 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 added: + ----- Method: Inspector>>streamErrorDoing:on: (in category 'fields - error handling') ----- + streamErrorDoing: aBlock on: aStream + + self + streamError: (self contentsForErrorDoing: aBlock) + on: aStream.! Item was added: + ----- Method: Inspector>>streamFieldsOn: (in category 'fields - streaming') ----- + streamFieldsOn: aStream + + self + streamBaseFieldsOn: aStream; + streamVariableFieldsOn: aStream; + streamCustomFieldsOn: aStream.! Item was added: + ----- 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 added: + ----- Method: Inspector>>streamInstanceVariablesOn: (in category 'fields - streaming') ----- + streamInstanceVariablesOn: aStream + + self object class 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: Inspector>>streamVariableFieldsOn: (in category 'fields - streaming') ----- + streamVariableFieldsOn: aStream + + self + streamInstanceVariablesOn: aStream; + streamIndexedVariablesOn: aStream.! Item was added: + ----- Method: Inspector>>textColorForError (in category 'user interface') ----- + textColorForError + + ^ TextColor color: ((self userInterfaceTheme get: #errorColor for: #TestRunner) ifNil: [Color red])! Item was removed: - ----- Method: Inspector>>timeOfLastListUpdate (in category 'accessing') ----- - timeOfLastListUpdate - ^ timeOfLastListUpdate ifNil: [timeOfLastListUpdate := 0]! Item was removed: - ----- 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 removed: - ----- Method: Inspector>>trash (in category 'accessing') ----- - trash - "What goes in the bottom pane" - ^ ''! Item was removed: - ----- Method: Inspector>>trash: (in category 'accessing') ----- - trash: newText - "Don't save it" - ^ true! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: Inspector>>typeOfSelection (in category 'selection - convenience') ----- + typeOfSelection + + ^ self selectedField ifNotNil: [:field | field type]! Item was changed: + ----- Method: Inspector>>typeValue: (in category 'user interface - styling') ----- - ----- Method: Inspector>>typeValue: (in category 'selecting') ----- typeValue: aTextOrString + "Style field value contents only after the user typed." + - - shouldStyleValuePane := true. contentsTyped := aTextOrString. + + shouldStyleValuePane == true ifFalse: [ + shouldStyleValuePane := true. + self changed: #style].! - self changed: #style.! Item was changed: + ----- Method: Inspector>>update (in category 'updating') ----- - ----- Method: Inspector>>update (in category 'accessing') ----- update + "For convenience." - "Reshow contents, assuming selected value may have changed." + self updateFields.! - | newText | - selectionIndex = 0 - ifFalse: - [self contentsIsString - ifTrue: [newText := self selection] - ifFalse: [newText := self selectionPrintString]. - self setContents: newText. - self changed: #selection. - self changed: #selectionIndex]! Item was added: + ----- Method: Inspector>>update: (in category 'updating') ----- + update: what + + what = #field ifTrue: [ + self updateFieldList. + self updateContentsSafely]. + + ^ super update: what! Item was added: + ----- Method: Inspector>>update:with: (in category 'updating') ----- + update: what with: parameter + + what = #deleteField + ifTrue: [self removeCustomField: parameter]. + + ^ super update: what with: parameter! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: Inspector>>updateStyler: (in category 'user interface - styling') ----- + updateStyler: aStyler + + self updateStyler: aStyler requestor: self.! Item was added: + ----- 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 class; + context: self doItContext; + parseAMethod: false.! Item was added: + ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: Inspector>>wantsSteps (in category 'accessing') ----- - wantsSteps - ^ true! Item was added: + ----- Method: Inspector>>wantsStepsIn: (in category 'updating - steps') ----- + wantsStepsIn: aWindow + "Independent of #smartUpdating preference". + + ^ true! Item was changed: + Model subclass: #InspectorBrowser + instanceVariableNames: 'inspector browser' - Inspector subclass: #InspectorBrowser - instanceVariableNames: '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 added: + ----- 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 added: + ----- Method: InspectorBrowser class>>inspect: (in category 'inspector compatibility') ----- + inspect: anObject + "ToolBuilder open: (self inspect: 42)" + + ^ self new inspect: anObject! Item was added: + ----- 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 added: + ----- Method: InspectorBrowser class>>openOn: (in category 'instance creation') ----- + openOn: anObject + + ^ ToolBuilder open: (self on: anObject)! Item was added: + ----- Method: InspectorBrowser class>>openOn:withLabel: (in category 'instance creation') ----- + openOn: anObject withLabel: label + + ^ ToolBuilder open: (self on: anObject) label: label! Item was removed: - ----- 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@0 corner: 0.3(a)0.3) -> [inspector buildFieldListWith: builder]. + (0.3@0 corner: 1.0(a)0.3) -> [inspector buildValuePaneWith: builder]. - (0@0 corner: 0.3(a)0.3) -> [self buildFieldListWith: builder]. - (0.3@0 corner: 1.0(a)0.3) -> [self buildValuePaneWith: builder]. (0(a)0.3 corner: 0.3(a)1.0) -> [browser buildMessageListWith: builder]. (0.3(a)0.3 corner: 1.0(a)1.0) -> [browser buildCodePaneWith: builder]. }. ^ builder build: windowSpec! Item was changed: + ----- Method: InspectorBrowser>>initialExtent (in category 'initialization') ----- - ----- Method: InspectorBrowser>>initialExtent (in category 'toolbuilder') ----- initialExtent + ^ (inspector initialExtent x max: browser initialExtent x) + @ ((inspector initialExtent y * 2/3) + browser initialExtent y)! - ^ super initialExtent * 3/2! Item was added: + ----- Method: InspectorBrowser>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + self setInspectorClass: Inspector. + self setBrowserClass: Browser.! Item was changed: + ----- Method: InspectorBrowser>>inspect: (in category 'initialization') ----- + inspect: anObject + "Reinitialize the inspector so that it is inspecting anObject." + + inspector inspect: anObject. + browser setClass: anObject class.! - ----- 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 - ! Item was added: + ----- Method: InspectorBrowser>>labelString (in category 'toolbuilder') ----- + labelString + "The window title" + + ^ 'Inspector Browser: ', inspector labelString! Item was added: + ----- Method: InspectorBrowser>>modelWakeUpIn: (in category 'stepping') ----- + modelWakeUpIn: aWindow + + inspector modelWakeUpIn: aWindow. + browser modelWakeUpIn: aWindow.! Item was added: + ----- Method: InspectorBrowser>>object (in category 'accessing') ----- + object + + ^ inspector object! Item was added: + ----- 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 added: + ----- Method: InspectorBrowser>>setBrowserClass: (in category 'initialization') ----- + setBrowserClass: aClass + + browser := aClass new.! Item was added: + ----- Method: InspectorBrowser>>setInspectorClass: (in category 'initialization') ----- + setInspectorClass: aClass + + inspector := aClass new. + inspector addDependent: self.! Item was changed: + ----- Method: InspectorBrowser>>stepAt:in: (in category 'stepping') ----- - ----- Method: InspectorBrowser>>stepAt:in: (in category 'stepping and presenter') ----- stepAt: millisecondClockValue in: aWindow + inspector stepAt: millisecondClockValue in: aWindow. - super stepAt: millisecondClockValue in: aWindow. browser stepAt: millisecondClockValue in: aWindow.! Item was added: + ----- Method: InspectorBrowser>>stepTimeIn: (in category 'stepping') ----- + stepTimeIn: aWindow + + ^ (inspector stepTimeIn: aWindow) + max: (browser stepTimeIn: aWindow)! Item was added: + ----- 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 added: + ----- Method: InspectorBrowser>>updateListsAndCodeIn: (in category 'stepping') ----- + updateListsAndCodeIn: aWindow + + inspector updateListsAndCodeIn: aWindow. + browser updateListsAndCodeIn: aWindow.! Item was added: + ----- Method: InspectorBrowser>>wantsStepsIn: (in category 'stepping') ----- + wantsStepsIn: aWindow + + ^ (inspector wantsStepsIn: aWindow) + or: [browser wantsStepsIn: aWindow]! Item was added: + 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 added: + ----- 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 added: + ----- Method: InspectorField class>>type: (in category 'instance creation') ----- + type: aSymbol + + ^ self new + type: aSymbol; + yourself! Item was added: + ----- Method: InspectorField class>>type:key: (in category 'instance creation') ----- + type: aSymbol key: anObject + + ^ (self type: aSymbol) + key: anObject + yourself! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: InspectorField>>editGetterFor: (in category 'custom - actions') ----- + editGetterFor: aStringHolder + + ^ self editGetterFor: aStringHolder orCancel: []! Item was added: + ----- Method: InspectorField>>editGetterFor:orCancel: (in category 'custom - actions') ----- + editGetterFor: anInspector orCancel: aBlock + + | code | + code := Project uiManager + request: 'Please enter an evaluable expression to get this field''s value:' translated asTextFromHtml + initialAnswer: self valueGetterExpression. + code isEmptyOrNil ifTrue: [^ aBlock value]. + + ^ self setGetterFor: anInspector to: code ifFail: aBlock! Item was added: + ----- Method: InspectorField>>editName (in category 'custom - actions') ----- + editName + + ^ self editNameOrCancel: []! Item was added: + ----- 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 added: + ----- Method: InspectorField>>editSetterFor: (in category 'custom - actions') ----- + editSetterFor: anInspector + + ^ self editSetterFor: anInspector orCancel: []! Item was added: + ----- Method: InspectorField>>editSetterFor:orCancel: (in category 'custom - actions') ----- + editSetterFor: anInspector orCancel: aBlock + + | code | + code := Project uiManager + request: 'Please enter an evaluable expression to set 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: InspectorField>>forgetInspector (in category 'private') ----- + forgetInspector + + inspector := nil.! Item was added: + ----- 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 added: + ----- Method: InspectorField>>inspector (in category 'private') ----- + inspector + + ^ inspector ifNil: [self dependents + detect: [:object | object isKindOf: Inspector] + ifNone: [nil]]! Item was added: + ----- Method: InspectorField>>isCustom (in category 'testing') ----- + isCustom + + ^ self type = #custom! Item was added: + ----- Method: InspectorField>>isReadOnly (in category 'testing') ----- + isReadOnly + + ^ self valueSetter isNil! Item was added: + ----- Method: InspectorField>>key (in category 'accessing') ----- + key + + ^ key! Item was added: + ----- Method: InspectorField>>key: (in category 'accessing') ----- + key: anObject + + self key = anObject ifTrue: [^ self]. + key := anObject. + self changed: #field.! Item was added: + ----- 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 added: + ----- Method: InspectorField>>name: (in category 'accessing') ----- + name: aString + + name = aString ifTrue: [^ self]. + name := aString. + self changed: #field.! Item was added: + ----- 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 added: + ----- Method: InspectorField>>printValueAsIs (in category 'initialization') ----- + printValueAsIs + + self shouldPrintValueAsIs: true.! Item was added: + ----- Method: InspectorField>>rememberInspector (in category 'private') ----- + rememberInspector + + inspector := self inspector.! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: InspectorField>>shouldPrintValueAsIs (in category 'accessing - printing') ----- + shouldPrintValueAsIs + "Whether to call #asString or #printString on this field's value." + + ^ shouldPrintValueAsIs ifNil: [false]! Item was added: + ----- Method: InspectorField>>shouldPrintValueAsIs: (in category 'accessing - printing') ----- + shouldPrintValueAsIs: aBoolean + "Whether to call #asString or #printString on this field's value." + + shouldPrintValueAsIs := aBoolean.! Item was added: + ----- Method: InspectorField>>shouldStyleName (in category 'accessing - printing') ----- + shouldStyleName + + ^ shouldStyleName ifNil: [false]! Item was added: + ----- Method: InspectorField>>shouldStyleName: (in category 'accessing - printing') ----- + shouldStyleName: aBoolean + + self shouldStyleName = aBoolean ifTrue: [^ self]. + shouldStyleName := aBoolean. + self changed: #field.! Item was added: + ----- Method: InspectorField>>shouldStyleValue (in category 'accessing - printing') ----- + shouldStyleValue + + ^ shouldStyleValue ifNil: [false]! Item was added: + ----- Method: InspectorField>>shouldStyleValue: (in category 'accessing - printing') ----- + shouldStyleValue: aBoolean + + self shouldStyleValue = aBoolean ifTrue: [^ self]. + shouldStyleValue := aBoolean. + self changed: #field.! Item was added: + ----- Method: InspectorField>>type (in category 'accessing') ----- + type + + ^ type! Item was added: + ----- Method: InspectorField>>type: (in category 'accessing') ----- + type: aSymbol + + type := aSymbol! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: InspectorField>>valueGetterExpression (in category 'accessing - code') ----- + valueGetterExpression + "The code string to run for getting the receiver's value." + + ^ self expressionWithReceiverName: #self! Item was added: + ----- Method: InspectorField>>valueGetterExpression: (in category 'accessing - code') ----- + valueGetterExpression: aString + + valueGetterExpression := aString.! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: InspectorField>>valueSetterExpression (in category 'accessing - code') ----- + valueSetterExpression + + ^ valueSetterExpression! Item was added: + ----- Method: InspectorField>>valueSetterExpression: (in category 'accessing - code') ----- + valueSetterExpression: aString + + valueSetterExpression := aString.! Item was changed: + ----- Method: Object>>basicInspect (in category '*Tools-Inspector') ----- - ----- Method: Object>>basicInspect (in category '*Tools-inspecting') ----- 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-Inspector') ----- - ----- Method: Object>>inspect (in category '*Tools-inspecting') ----- 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-Inspector') ----- - ----- Method: Object>>inspectWithLabel: (in category '*Tools-inspecting') ----- 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-Inspector') ----- - ----- Method: Object>>inspectorClass (in category '*Tools-inspecting') ----- 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 removed: - ----- 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 removed: - Inspector subclass: #OrderedCollectionInspector - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Inspector'! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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]. + ToolSet + inspect: pointers + label: 'Objects pointing to ' , selectedProcess browserPrintString! - OrderedCollectionInspector - openOn: pointers - withLabel: 'Objects pointing to ' , selectedProcess browserPrintString! Item was changed: + CollectionInspector subclass: #SetInspector - Inspector subclass: #SetInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tools-Inspector'! + !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.! - !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.! Item was removed: - ----- Method: SetInspector>>arrayIndexForSelection (in category 'selecting') ----- - arrayIndexForSelection - ^ (self fieldList at: selectionIndex) asInteger! Item was removed: - ----- 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 added: + ----- Method: SetInspector>>elementGetterAt: (in category 'private') ----- + elementGetterAt: index + + ^ [:set | (set array at: index) enclosedSetElement]! Item was added: + ----- 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 added: + ----- 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 removed: - ----- 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 added: + ----- Method: SetInspector>>isElementValid: (in category 'private') ----- + isElementValid: anElement + + ^ anElement notNil! Item was removed: - ----- 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 removed: - ----- 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 'selection') ----- - ----- Method: SetInspector>>replaceSelectionValue: (in category 'selecting') ----- replaceSelectionValue: 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] ]].! - ^ object array at: self arrayIndexForSelection put: anObject! Item was removed: - ----- 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 a basic inspector on the given object." + ^ BasicInspector openOn: 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! Item was changed: ----- Method: WeakSet>>inspectorClass (in category '*Tools-Inspector') ----- inspectorClass ^ WeakSetInspector! Item was changed: SetInspector subclass: #WeakSetInspector + instanceVariableNames: '' - instanceVariableNames: 'flagObject' 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 removed: - ----- 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 removed: - ----- Method: WeakSetInspector>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - flagObject := object instVarNamed: 'flag'. ! Item was added: + ----- 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 added: + (PackageInfo named: 'Tools') postscript: '(Smalltalk globals at: #ObjectsUnderInspection ifAbsent: [#()]) + do: [:objectUnderInspection | + ToolSet inspect: objectUnderInspection]. + Smalltalk globals removeKey: #ObjectsUnderInspection.'!

1 0

The Trunk: Morphic-mt.1653.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1653.mcz ==================== Summary ==================== Name: Morphic-mt.1653 Author: mt Time: 27 April 2020, 10:11:39.00234 am UUID: 8c21e8a4-388d-8c4d-bafe-d48c875354a2 Ancestors: Morphic-mt.1652 Avoid message send to object-under-inspection to not discard references to proxies. Remove soon-to-be deprecated #inspectElement. =============== Diff against Morphic-mt.1652 =============== Item was removed: - ----- Method: MorphExtension>>inspectElement (in category 'other') ----- - inspectElement - "Create and schedule an Inspector on the otherProperties and the - named properties." - | key obj | - key := UIManager default chooseFrom: self sortedPropertyNames values: self sortedPropertyNames title: 'Inspect which property?'. - key - ifNil: [^ self]. - obj := otherProperties - at: key - ifAbsent: ['nOT a vALuE']. - obj = 'nOT a vALuE' - ifTrue: [(self perform: key) inspect - "named properties"] - ifFalse: [obj inspect]! Item was changed: ----- Method: TextEditor>>inspectIt (in category 'do-its') ----- inspectIt self evaluateSelectionAndDo: [:result | (model respondsTo: #inspectIt:result:) ifTrue: [model perform: #inspectIt:result: with: self selection with: result] + ifFalse: [ToolSet inspect: result]].! - ifFalse: [result inspect]].!

1 0

The Trunk: ST80-mt.253.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-mt.253.mcz ==================== Summary ==================== Name: ST80-mt.253 Author: mt Time: 27 April 2020, 10:10:03.42034 am UUID: 4c5e810c-df68-3e46-b9cc-f84546547355 Ancestors: ST80-dtl.252 Remove explicit class reference and rely on #inspectorClass. Avoid message send to object-under-inspector to not discard references to proxies. =============== Diff against ST80-dtl.252 =============== Item was changed: ----- Method: FormInspectView class>>openOn:withLabel: (in category 'instance creation') ----- openOn: aFormDictionary withLabel: aLabel "open a graphical dictionary in a window having the label aLabel. aFormDictionary should be a dictionary containing as value a form." + ^ aFormDictionary inspectWithLabel: aLabel - ^ DictionaryInspector - openOn: aFormDictionary - withLabel: aLabel ! Item was changed: ----- Method: ParagraphEditor>>inspectIt (in category 'do-its') ----- inspectIt + self evaluateSelectionAndDo: [:result | ToolSet inspect: result]. - self evaluateSelectionAndDo: [:result | result inspect]. !

1 0

The Trunk: KernelTests-mt.379.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-mt.379.mcz ==================== Summary ==================== Name: KernelTests-mt.379 Author: mt Time: 27 April 2020, 9:54:41.95034 am UUID: fc3b629e-c81d-ee49-afe9-9de723098aff Ancestors: KernelTests-nice.378 Removes a dependency from KernelTests to Tools package. =============== Diff against KernelTests-nice.378 =============== Item was changed: ----- Method: ClassTest>>testChangeClassOf (in category 'tests') ----- testChangeClassOf "Exercise primitiveChangeClass (primitive 115) for a common use case. This should pass for any Squeak image format (but failed for image format 68002 prior to VM fix)" + self shouldnt: [Exception new primitiveChangeClassTo: Error new] raise: Error! - self shouldnt: [Inspector new primitiveChangeClassTo: CompiledMethodInspector new] raise: Error!

1 0

The Trunk: Morphic-mt.1652.mcz
by commits＠source.squeak.org 27 Apr '20

27 Apr '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1652.mcz ==================== Summary ==================== Name: Morphic-mt.1652 Author: mt Time: 27 April 2020, 9:31:57.493264 am UUID: d23bbde5-4e42-3547-960d-39994fc21f56 Ancestors: Morphic-ct.1651 Fixes regression #browseIt in TraceMessages, too. Now all recent hick-ups with TraceMessages are gone. There are still some hooks missing such as #browseAllAccessTo:from:. However, I think we should push down those backstops from Object to Model. Note that I already backported this fix to Squeak 5.3. =============== Diff against Morphic-ct.1651 =============== Item was changed: ----- Method: TextEditor>>browseIt (in category 'menu messages') ----- browseIt "Launch a browser for the current selection, if appropriate." Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. self lineSelectAndEmptyCheck: [^ morph flash]. "First, try to show all accesses to instance or class variables." self selectedInstanceVariable ifNotNil: [:nameToClass | self systemNavigation browseAllAccessesTo: nameToClass key from: nameToClass value]. self selectedClassVariable ifNotNil: + [:binding | self model browseAllCallsOn: binding]. - [:binding | self systemNavigation browseAllCallsOn: binding]. "Then, either browse the class (from a binding) or all implementors of a selector." self selectedBinding ifNotNil: [:binding | ^ self systemNavigation browseClass: binding]. self selectedSelector ifNotNil: + [:selector | ^ self model browseAllImplementorsOf: selector]. - [:selector | ^ self systemNavigation browseAllImplementorsOf: selector]. morph flash!

1 0

The Trunk: Morphic-ct.1651.mcz
by commits＠source.squeak.org 26 Apr '20

26 Apr '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1651.mcz ==================== Summary ==================== Name: Morphic-ct.1651 Author: ct Time: 26 April 2020, 6:09:17.326958 pm UUID: 74e97e50-024a-4541-a7f7-0677904a8350 Ancestors: Morphic-mt.1650 Completes fix of #traceMessage preference, see Morphic-mt.1650. Now #sendersOfIt works again, too :-) =============== Diff against Morphic-mt.1650 =============== Item was changed: ----- Method: TextEditor>>sendersOfIt (in category 'menu messages') ----- sendersOfIt "Open a senders browser on the selected selector" self lineSelectAndEmptyCheck: [^ self]. + self selectedSelector ifNotNil: [:aSelector | + ^ self model browseAllCallsOn: aSelector]. + self selectedLiteral ifNotNil: [:aLiteral | + ^ self model browseAllCallsOn: aLiteral]. + morph flash.! - self selectedSelector ifNotNil: - [:aSelector| ^self systemNavigation browseAllCallsOn: aSelector]. - self selectedLiteral ifNotNil: - [:aLiteral| ^self systemNavigation browseAllCallsOn: aLiteral]. - morph flash!

1 0

The Trunk: Collections-mt.889.mcz
by commits＠source.squeak.org 26 Apr '20

26 Apr '20

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-mt.889.mcz ==================== Summary ==================== Name: Collections-mt.889 Author: mt Time: 26 April 2020, 6:45:20.736934 pm UUID: 2f716cfd-4552-b54e-bfe3-43ac798f8087 Ancestors: Collections-mt.888 Makes BitSet's printString more informative. =============== Diff against Collections-mt.888 =============== Item was added: + ----- Method: Bitset>>printElementsOn:separatedBy: (in category 'printing') ----- + printElementsOn: aStream separatedBy: delimiter + "Overridden to always inform about the entire set of bits." + + (0 to: self capacity-1) + do: [:index | aStream print: (self bitAt: index)] + separatedBy: [aStream nextPutAll: delimiter asString].!

1 0

The Trunk: Morphic-mt.1650.mcz
by commits＠source.squeak.org 26 Apr '20

26 Apr '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1650.mcz ==================== Summary ==================== Name: Morphic-mt.1650 Author: mt Time: 26 April 2020, 4:32:03.107807 pm UUID: 95ace312-f82d-344a-b874-af727eb37a41 Ancestors: Morphic-mt.1649 Fixes oversight from last commit to make TraceMessages work again. See: http://forum.world.st/The-Trunk-Morphic-mt-1649-mcz-tp5115336.html =============== Diff against Morphic-mt.1649 =============== Item was changed: ----- Method: TextEditor>>implementorsOfIt (in category 'menu messages') ----- implementorsOfIt "Open an implementors browser on the selected selector" self lineSelectAndEmptyCheck: [^ self]. self selectedSelector ifNotNil: + [:aSelector| ^self model browseAllImplementorsOf: aSelector]. - [:aSelector| ^self systemNavigation browseAllImplementorsOf: aSelector]. self selectedLiteral ifNotNil: + [:aLiteral| ^self model browseAllImplementorsOf: aLiteral]. - [:aLiteral| ^self systemNavigation browseAllImplementorsOf: aLiteral]. morph flash.!

1 0

The Trunk: ST80-dtl.252.mcz
by commits＠source.squeak.org 25 Apr '20

25 Apr '20

David T. Lewis uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-dtl.252.mcz ==================== Summary ==================== Name: ST80-dtl.252 Author: dtl Time: 25 April 2020, 11:33:47.596261 am UUID: 1ffa2601-fb84-480f-9e22-f3bd1961caeb Ancestors: ST80-mt.251, ST80-nice.249 Merge =============== Diff against ST80-mt.251 =============== Item was changed: ----- Method: TestIndenting>>testCR (in category 'tests') ----- testCR "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 8. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testCR3 (in category 'tests') ----- testCR3 "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 12. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testNewLineAndTabProvidesDoubleIndent (in category 'tests') ----- testNewLineAndTabProvidesDoubleIndent "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. - cb := para characterBlockForIndex: 12. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testNewLineStartsIndented (in category 'tests') ----- testNewLineStartsIndented "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. + leftMargin := para textStyle leftMarginTabAt: 1. - cb := para characterBlockForIndex: 8. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testNewLineStartsIndentedWhenWrapped (in category 'tests') ----- testNewLineStartsIndentedWhenWrapped "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para compositionRectangle: (0@0 extent: para width - 24@100); updateCompositionHeight. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 8. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testSetUp (in category 'tests') ----- testSetUp "just reminding us all what the paragraph looks like to begin with. assuming Accuny12 font " + | cb firstTabStop | + firstTabStop := para textStyle nextTabXFrom: 1 leftMargin: 0 rightMargin: 200. - | cb | - cb := para characterBlockForIndex: 1. "p" self assert: cb top = 0. self assert: cb left = 0. self assert: cb right = 7. - cb := para characterBlockForIndex: 2. "the tab" self assert: cb top = 0. self assert: cb left = 7. + self assert: cb right = firstTabStop. - self assert: cb right = 24. - cb := para characterBlockForIndex: 3. "w" self assert: cb top = 0. + self assert: cb left = firstTabStop. + self assert: cb right = (firstTabStop + 10). - self assert: cb left = 24. - self assert: cb right = 34. cb := para characterBlockForIndex: 7. " " "between word and word" self assert: cb top = 0. + self assert: cb left = (firstTabStop + 28). + self assert: cb right = (firstTabStop + 33). - self assert: cb left = 52. - self assert: cb right = 57. cb := para characterBlockForIndex: 11. "d" "last char" self assert: cb top = 0. + self assert: cb left = (firstTabStop + 55). + self assert: cb right = (firstTabStop + 61). - self assert: cb left = 79. - self assert: cb right = 85. !

1 0

The Trunk: ST80-nice.249.mcz
by commits＠source.squeak.org 25 Apr '20

25 Apr '20

David T. Lewis uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-nice.249.mcz ==================== Summary ==================== Name: ST80-nice.249 Author: nice Time: 7 March 2020, 10:15:56.235551 pm UUID: ab4fcf8c-acb9-4cde-83e0-57846e89aa42 Ancestors: ST80-mt.248 Let TestIndenting pass whatever custom tab stops. In some image, I have set the tab stops like that: (TextConstants at: #DefaultTabsArray) becomeForward: (32 to: 1536 by: 32) asArray. (TextConstants at: #DefaultMarginTabsArray) becomeForward: ((32 to: 768 by: 32) collect: [:i | {i. i}]). =============== Diff against ST80-mt.248 =============== Item was changed: ----- Method: TestIndenting>>testCR (in category 'tests') ----- testCR "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 8. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testCR3 (in category 'tests') ----- testCR3 "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 12. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testNewLineAndTabProvidesDoubleIndent (in category 'tests') ----- testNewLineAndTabProvidesDoubleIndent "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 11 to: 11 with: (Text string: (String with: Character cr) attribute: (TextIndent tabs: 1)) displaying: false. - cb := para characterBlockForIndex: 12. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testNewLineStartsIndented (in category 'tests') ----- testNewLineStartsIndented "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para replaceFrom: 7 to: 7 with: (String with: Character cr) displaying: false. + leftMargin := para textStyle leftMarginTabAt: 1. - cb := para characterBlockForIndex: 8. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testNewLineStartsIndentedWhenWrapped (in category 'tests') ----- testNewLineStartsIndentedWhenWrapped "Checks whether the beginning of a new line starts at the indented position" + | cb leftMargin | - | cb | para compositionRectangle: (0@0 extent: para width - 24@100); updateCompositionHeight. para clippingRectangle: (0@0 extent: 200@200). cb := para characterBlockForIndex: 8. + leftMargin := para textStyle leftMarginTabAt: 1. self assert: cb top > 0. + self assert: cb left = leftMargin! - self assert: cb left = 24! Item was changed: ----- Method: TestIndenting>>testSetUp (in category 'tests') ----- testSetUp "just reminding us all what the paragraph looks like to begin with. assuming Accuny12 font " + | cb firstTabStop | + firstTabStop := para textStyle nextTabXFrom: 1 leftMargin: 0 rightMargin: 200. - | cb | - cb := para characterBlockForIndex: 1. "p" self assert: cb top = 0. self assert: cb left = 0. self assert: cb right = 7. - cb := para characterBlockForIndex: 2. "the tab" self assert: cb top = 0. self assert: cb left = 7. + self assert: cb right = firstTabStop. - self assert: cb right = 24. - cb := para characterBlockForIndex: 3. "w" self assert: cb top = 0. + self assert: cb left = firstTabStop. + self assert: cb right = (firstTabStop + 10). - self assert: cb left = 24. - self assert: cb right = 34. cb := para characterBlockForIndex: 7. " " "between word and word" self assert: cb top = 0. + self assert: cb left = (firstTabStop + 28). + self assert: cb right = (firstTabStop + 33). - self assert: cb left = 52. - self assert: cb right = 57. cb := para characterBlockForIndex: 11. "d" "last char" self assert: cb top = 0. + self assert: cb left = (firstTabStop + 55). + self assert: cb right = (firstTabStop + 61). - self assert: cb left = 79. - self assert: cb right = 85. !

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages April 2020