[squeak-dev] The Inbox: Tools-ct.900.mcz

Chris Muller ma.chris.m at gmail.com
Fri Oct 25 20:08:48 UTC 2019


Hi,

> > Please correct me if I'm wrong, but these specs have a finite
> enumeration of symbolic "types" that the slot (field) can be, is that
> right?  So what are all the possible types?  <--- This is a rhetorical
> question to suggest it may be worth factoring those specs into a
> first-class object, so their API can "document" all the possible types, and
> be more obvious how to use them to extend the Inspector.
> >
> > If you don't feel it's worth it, then please leave a good comment
> somewhere (i.e., createSlotSpecs) which describes the format of the specs
> and their use.
> The point is, the list of slot types varies from inspector class to
> inspector class. I'm not sure if I understand your idea correctly, would
> you like to introduce a class per each slot type?  Then each class
> inheriting from Inspector would possibly need to define separate slot
> classes. Or do I misunderstand you?
>
However, a quite good overview of all slot types a class is using can be
> viewed by browsing the inheritance of #selection.
>

I meant a single class which simply gave names to what you're using for
#key and #value of your Associations.  But whether its one class for all
types, or one class per type, or neither but just a good comment somewhere
-- the goal is to help future readers unfamiliar with that spec structure
understand it quickly.

Best,
  Chris



>
> Best,
> Christoph
>
> ------------------------------
> *Von:* Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im
> Auftrag von Chris Muller <asqueaker at gmail.com>
> *Gesendet:* Freitag, 25. Oktober 2019 01:34:35
> *An:* The general-purpose Squeak developers list
> *Cc:* ma.chris.m at gmail.com
> *Betreff:* Re: [squeak-dev] The Inbox: Tools-ct.900.mcz
>
> Hi Christoph,
>
> I was able to take a very brief in-image look..   This looks like some
> really good work, thank you!
>
> On Wed, Oct 23, 2019 at 2:56 AM Thiede, Christoph <
> Christoph.Thiede at student.hpi.uni-potsdam.de> wrote:
>
>> Alright, I can rename this back.
>>
> I was responding only to your stated reasoning for choosing "slot".  It
> actually seems fine here, but there's nothing wrong with "field"
> nomenclature either, and it does match better with #fieldList..
>
>> Anything else in this commit you would like me to refactor?
>>
> Please correct me if I'm wrong, but these specs have a finite enumeration
> of symbolic "types" that the slot (field) can be, is that right?  So what
> are all the possible types?  <--- This is a rhetorical question to suggest
> it may be worth factoring those specs into a first-class object, so their
> API can "document" all the possible types, and be more obvious how to use
> them to extend the Inspector.
>
> If you don't feel it's worth it, then please leave a good comment
> somewhere (i.e., createSlotSpecs) which describes the format of the specs
> and their use.
>
> Best,
>   Chris
>
>
>
>> *Von:* Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im
>> Auftrag von Chris Muller <asqueaker at gmail.com>
>> *Gesendet:* Sonntag, 20. Oktober 2019 23:47:00
>> *An:* The general-purpose Squeak developers list
>> *Betreff:* Re: [squeak-dev] The Inbox: Tools-ct.900.mcz
>>
>> This looks like a great improvement in the design that paves the way for
>> more advanced inspections.
>>
>> > About nomenclature: I think the term "field list" is not very accurate
>> as the list does not contain fields only but also inst vars, temp vars,
>> literals, and other representations. If you still think we
>> > should keep that term for compatibility, "slotSpecs" could be surely
>> renamed to "fieldSpecs" or "fieldListSpecs", whatever you want :)
>>
>> "Field" is a perfectly general term that means, "access to a piece of
>> information", and not anything about its data source (inst var, etc.).  The
>> description of the Smalltalk language doesn't utilize the word.
>> Personally, I would only use "slot" nomenclature if I needed to describe a
>> first-class slot object, a "holder" or reference to another object, but
>> with its own properties of holding and access (i.e., #nonNull,
>> #defaultValue, etc.).
>>
>> Best,
>>   Chris
>>
>>
>>
>> On Wed, Oct 16, 2019 at 6:18 AM Thiede, Christoph <
>> Christoph.Thiede at student.hpi.uni-potsdam.de> wrote:
>>
>>> Hi Marcel,
>>>
>>>
>>> thank you for the question, I will try to describe my thoughts more in
>>> detail :)
>>>
>>>
>>> I noticed a lot of duplicated code in Inspector withAllSubclasses,
>>> regarding the mapping between selectionIndex, selection and
>>> selectedObjectIndex. There were also many hardcoded indices that would have
>>> made it hard to apply any change to the arrangement of slots (e.g., if you
>>> would like to add "all class vars" below "all inst vars"), it was kind of
>>> shotgun surgery. Also, I added a new ellipsis entry which made the mapping
>>> even more sophisticated:
>>>
>>>
>>>
>>>
>>> Thus I tried to bundle all these methods (such as #selection,
>>> #defsOfSelection, #sendersOfSelectedKey, #inspectKey,
>>> #selectedObjectIndex, etc. pp. ...) in the base class. There are now:
>>>
>>> - *#slotSpecs:* an OrderedDictionary which contains items of the form
>>> (aStringOrTextLabel -> aSymbolForTypeOfSelection) OR (aStringOrTextLabel ->
>>> {aSymbolForTypeOfSelection. anIndexLocalToSelection}). #slotSpecs is
>>> created once (until #updateEntries is called).
>>>
>>> - *#fieldList,* which contains the labels of the slot pane as usual and
>>> is computed based on #slotSpecs.
>>>
>>>
>>> For example, given [ (1 to: 200) collect: [:i | i asWords -> (i
>>> squared)] as: Dictionary ], the #slotSpecs will look like:
>>>
>>>
>>> That way we save some additional mapping complexity when accessing the
>>> current selection.
>>>
>>> Moreover, Inspector provides #selectedIndexOf: aSymbol.
>>>
>>>
>>> In summary, subclasses such as CompiledMethodInspector can simplify
>>> their implementation to:
>>>
>>>
>>>
>>> About nomenclature: I think the term "field list" is not very accurate
>>> as the list does not contain fields only but also inst vars, temp vars,
>>> literals, and other representations. If you still think we should keep that
>>> term for compatibility, "slotSpecs" could be surely renamed to "fieldSpecs"
>>> or "fieldListSpecs", whatever you want :)
>>>
>>>
>>> I hope I've been able to make my intention a little clearer.
>>> Otherwise, please don't hesitate to ask me again (:
>>>
>>>
>>> Best,
>>>
>>> Christoph
>>> ------------------------------
>>> *Von:* Squeak-dev <squeak-dev-bounces at lists.squeakfoundation.org> im
>>> Auftrag von Taeumel, Marcel
>>> *Gesendet:* Mittwoch, 16. Oktober 2019 11:03:21
>>> *An:* gettimothy via Squeak-dev
>>> *Betreff:* Re: [squeak-dev] The Inbox: Tools-ct.900.mcz
>>>
>>> Hi Christoph. :-)
>>>
>>> > - Introduces cached #slotSpecs to describe fieldList on a higher
>>> level and increase reuse
>>>
>>> Can you please describe your perception of "fieldList" and the proposed
>>> "slotSpecs" so we can better understand your intentions? A "spec" is such
>>> an abstract term that could mean everything and nothing. :-) What do you
>>> specify? Why not "fieldSpec"? Why rername "field" to "slot" and "list" to
>>> "spec"? Thank you for these contributions!
>>>
>>> Best,
>>> Marcel
>>>
>>> Am 02.10.2019 23:14:51 schrieb commits at source.squeak.org <
>>> commits at source.squeak.org>:
>>> A new version of Tools was added to project The Inbox:
>>> http://source.squeak.org/inbox/Tools-ct.900.mcz
>>>
>>> ==================== Summary ====================
>>>
>>> Name: Tools-ct.900
>>> Author: ct
>>> Time: 2 October 2019, 11:14:40.791682 pm
>>> UUID: 357fedaf-0521-1f47-b744-53cedfc995c4
>>> Ancestors: Tools-ul.899
>>>
>>> Miscellaneous improvements, bugfixes & refactoring (mainly
>>> cleanup/deduplication) for the Inspector classes
>>>
>>> Overall deduplication; refines interface for subclasses:
>>> - Bundles updating logic
>>> - Introduces #typeOfSelection instead of hard-coded, redundant index
>>> numbers
>>> - Fixes #copyName for subclasses by introducing #nameOfSelection
>>> - Introduces cached #slotSpecs to describe fieldList on a higher level
>>> and increase reuse
>>> - Decomposes field list menu creation and override methods: saves heavy
>>> duplication and allows for more situational menus (only show items)
>>> - Merges menu items "stores into" and "assignments..." such as "defs of
>>> selection" and "references..."
>>> - International support in menus
>>> - Adds some simple formatting for field list
>>> - Removes some deprecations (#trash, #classOfSelection)
>>> - Recategorization
>>> - Refines long field list truncation and displays an ellipsis
>>> - Replace #i1 and #i2 by some more expressive names
>>> - Makes #inspectElement work again
>>> - Pass requestor to compiler when acceping a value (to get inline syntax
>>> errors)
>>> - immediately update value pane after replacing selection value
>>> - bugfix: always reset styling when value pane is updated
>>> - bugfix: show printString error instead of opening a Debugger, when
>>> 'all inst vars' is selected and any inst var cannot be printed
>>> - bugfix: not all displayed field list menu shortcuts were supported
>>> - Registers more specific #inspectorClass for Context
>>> - Don't absorb too many errors in #defaultIntegerBase
>>> - Fixes some comments and typos
>>>
>>> Still to do:
>>> - Consider further deprecations as described in
>>> http://forum.world.st/Tools-Possible-deprecations-in-Inspector-td5103248.html
>>>
>>> Please review!
>>> I apologize for the large commit, but most changes are rather strongly
>>> linked and I found it hard to decouple them, preserving topological order.
>>> If needed, this may be also considered a working commit and I will be happy
>>> to implement all your feedback in further commits* :-)
>>>
>>> * but not before October 14th, as I'm going to take a vacation ;)
>>>
>>>
>>>
>>> ---
>>>
>>> For testing, here are some expressions you can inspect (just to save you
>>> some typing effort):
>>>
>>> Morph new.
>>> (1 to: 200) collect: [:i | i -> (i asWords)] as: Dictionary.
>>> (1 to: 200) collect: #asWords as: OrderedCollection.
>>> (1 to: 200) collect: #asWords as: Set.
>>> { World. Morph. nil. thisContext } as: WeakSet.
>>> [:i :x | |p qqqqq| p := i // x. qqqqq := x \\ i. [self halt] fork.
>>> thisContext] value: 42 value: 17.
>>> Parser >> #messagePart:repeat:.
>>>
>>> ---
>>>
>>> =============== Diff against Tools-ul.899 ===============
>>>
>>> Item was changed:
>>> Inspector subclass: #BasicInspector
>>> instanceVariableNames: ''
>>> classVariableNames: ''
>>> poolDictionaries: ''
>>> category: 'Tools-Inspector'!
>>> +
>>> + !BasicInspector commentStamp: 'ct 9/26/2019 13:34' prior: 0!
>>> + I am a Inspector that displays the instance variables of my inspectee
>>> only, but not any kind of special informations such as my sibling classes
>>> do.!
>>>
>>> Item was changed:
>>> + ----- Method: CompiledMethodInspector>>contentsIsString (in category
>>> 'accessing - selection') -----
>>> - ----- Method: CompiledMethodInspector>>contentsIsString (in category
>>> 'selecting') -----
>>> contentsIsString
>>> - "Hacked so contents empty when deselected"
>>>
>>> + ^ super contentsIsString or: [#(byteCodes header) includes: self
>>> typeOfSelection]!
>>> - ^ #(0 2 3) includes: selectionIndex!
>>>
>>> Item was added:
>>> + ----- Method: CompiledMethodInspector>>createSlotSpecs (in category
>>> 'accessing') -----
>>> + createSlotSpecs
>>> +
>>> + | keys |
>>> + keys := super createSlotSpecs first: 1.
>>> + keys
>>> + at: '*all bytecodes*' asHtmlText put: #byteCodes;
>>> + at: '*header*' asHtmlText put: #header.
>>> + keys addAll: (
>>> + (1 to: object numLiterals) collect: [:i | 'literal', i -> {#literal.
>>> i}]).
>>> + keys addAll: (self truncateList: (
>>> + (object initialPC to: object size) collect: [:pc | pc asString ->
>>> {#pc. pc}])).
>>> + ^ keys!
>>>
>>> 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 added:
>>> + ----- Method: CompiledMethodInspector>>nameOfSelection (in category
>>> 'accessing - selection') -----
>>> + nameOfSelection
>>> +
>>> + ^ self typeOfSelection
>>> + caseOf: {
>>> + [#byteCodes] -> ['self symbolic'].
>>> + [#header] -> ['self headerDescription'].
>>> + [#literal] -> ['(self objectAt: {1})' format: {(self selectedIndexOf:
>>> #literal) + 1}].
>>> + [#pc] -> ['(self at: {1})' format: {object initialPC + self
>>> selectedObjectIndex - 2}] }
>>> + otherwise: [super nameOfSelection]!
>>>
>>> Item was changed:
>>> + ----- Method: CompiledMethodInspector>>selection (in category
>>> 'accessing - selection') -----
>>> - ----- Method: CompiledMethodInspector>>selection (in category
>>> 'selecting') -----
>>> selection
>>>
>>> + ^ self typeOfSelection
>>> + caseOf: {
>>> + [#byteCodes] -> [object symbolic].
>>> + [#header] -> [object headerDescription].
>>> + [#literal] -> [object objectAt: (self selectedIndexOf: #literal) + 1].
>>> + [#pc] -> [object at: (self selectedIndexOf: #pc)] }
>>> + otherwise: [super selection]!
>>> - | bytecodeIndex |
>>> - selectionIndex = 0 ifTrue: [^ ''].
>>> - selectionIndex = 1 ifTrue: [^ object ].
>>> - selectionIndex = 2 ifTrue: [^ object symbolic].
>>> - selectionIndex = 3 ifTrue: [^ object headerDescription].
>>> - selectionIndex <= (object="" numliterals="" +="" 3)="">
>>> - ifTrue: [ ^ object objectAt: selectionIndex - 2 ].
>>> - bytecodeIndex := selectionIndex - object numLiterals - 3.
>>> - ^ object at: object initialPC + bytecodeIndex - 1!
>>>
>>> Item was added:
>>> + ----- Method: CompiledMethodInspector>>selectionIsSpecial (in category
>>> 'accessing - selection') -----
>>> + selectionIsSpecial
>>> +
>>> + ^ super selectionIsSpecial or: [
>>> + #(byteCodes header) includes: self typeOfSelection]!
>>>
>>> Item was changed:
>>> + ----- Method: CompiledMethodInspector>>selectionUnmodifiable (in
>>> category 'accessing - selection') -----
>>> - ----- 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 added:
>>> + ----- Method: ContextInspector>>createSlotSpecs (in category
>>> 'accessing') -----
>>> + createSlotSpecs
>>> +
>>> + | tempNames stackIndices |
>>> + tempNames := object tempNames
>>> + collectWithIndex: [:t :i | '[', t, ']' -> {#tempVar. i}].
>>> + stackIndices := (object numTemps + 1 to: object stackPtr)
>>> + collect: [:i | i printString -> {#field. i}].
>>> + ^ self createBaseSlotSpecs, tempNames, stackIndices!
>>>
>>> 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 added:
>>> + ----- Method: ContextInspector>>nameOfSelection (in category
>>> 'accessing - selection') -----
>>> + nameOfSelection
>>> +
>>> + self typeOfSelection = #tempVar
>>> + ifFalse: [^ super nameOfSelection].
>>> + ^ '(self at: {1})' format: {self selectedIndexOf: #tempVar}
>>> + !
>>>
>>> Item was changed:
>>> + ----- Method: ContextInspector>>selection (in category 'accessing -
>>> selection') -----
>>> - ----- Method: ContextInspector>>selection (in category 'accessing')
>>> -----
>>> selection
>>> + "Answer the value of the selected slot."
>>> +
>>> + ^ self typeOfSelection
>>> + caseOf: {
>>> + [#tempVar] -> [object debuggerMap
>>> + namedTempAt: (self selectedIndexOf: #tempVar)
>>> + in: object].
>>> + [#field] -> [object at: self selectedObjectIndex] }
>>> + otherwise: [super 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="">
>>> - [^object instVarAt: selectionIndex - 2].
>>> - basicIndex := selectionIndex - 2 - object class instSize.
>>> - basicIndex <= object="" numtemps="">
>>> - [^object debuggerMap namedTempAt: basicIndex in: object].
>>> - basicIndex <= object="" stackptr="">
>>> - [^object at: basicIndex].
>>> - ^nil
>>> - !
>>>
>>> Item was changed:
>>> ----- Method: ContextVariablesInspector>>aboutToStyle:forMorph: (in
>>> category 'styling') -----
>>> aboutToStyle: aStyler forMorph: aMorph
>>>
>>> - (super aboutToStyle: aStyler forMorph: aMorph)
>>> - ifFalse: [^ false].
>>> aStyler
>>> classOrMetaClass: self doItReceiver class;
>>> context: self doItContext.
>>> + ^ super aboutToStyle: aStyler forMorph: aMorph!
>>> - ^ true!
>>>
>>> Item was added:
>>> + ----- Method: ContextVariablesInspector>>addCollectionItemsTo: (in
>>> category 'menu') -----
>>> + addCollectionItemsTo: aMenu
>>> +
>>> + self typeOfSelection = #allTempVars
>>> + ifTrue: [^ false].
>>> + ^ super addCollectionItemsTo: aMenu!
>>>
>>> Item was added:
>>> + ----- Method: ContextVariablesInspector>>addFieldItemsTo: (in category
>>> 'menu') -----
>>> + addFieldItemsTo: aMenu
>>> +
>>> + self typeOfSelection = #allTempVars
>>> + ifTrue: [^ false].
>>> + ^ super addFieldItemsTo: aMenu!
>>>
>>> Item was changed:
>>> + ----- Method: ContextVariablesInspector>>contentsIsString (in category
>>> 'accessing - selection') -----
>>> - ----- Method: ContextVariablesInspector>>contentsIsString (in category
>>> 'selecting') -----
>>> contentsIsString
>>> - "Hacked so contents empty when deselected and = long printString when
>>> item 3"
>>>
>>> + self typeOfSelection = #allTempVars
>>> + ifTrue: [^ true].
>>> + ^ super contentsIsString!
>>> - ^ (selectionIndex = 3) | (selectionIndex = 0) |
>>> - (selectionIndex = 2 and: [object actualStackSize = 0])!
>>>
>>> Item was added:
>>> + ----- Method: ContextVariablesInspector>>createSlotSpecs (in category
>>> 'accessing') -----
>>> + createSlotSpecs
>>> + "Refer to the comment in Inspector|fieldList."
>>> +
>>> + object == nil ifTrue: [^ OrderedDictionary new].
>>> + ^ fieldList ifNil: [ | styler |
>>> + styler := SHTextStylerST80 new.
>>> + styler context: object.
>>> + fieldList := OrderedDictionary newFrom: {
>>> + (styler styledTextFor: 'thisContext' asText) -> #thisContext.
>>> + '*stack top*' asHtmlText -> #stackTop.
>>> + '*all temp vars*' asHtmlText -> #allTempVars }
>>> + , (object tempNames collectWithIndex: [:name :index |
>>> + (styler styledTextFor: name asText) -> {#tempVar. index}])]!
>>>
>>> Item was changed:
>>> + ----- Method: ContextVariablesInspector>>defaultIntegerBase (in
>>> category 'accessing') -----
>>> - ----- 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."
>>> + | methodClass |
>>> + methodClass := object method methodClass.
>>> + ^ (methodClass respondsTo: #defaultIntegerBaseInDebugger)
>>> + ifTrue: [methodClass defaultIntegerBaseInDebugger]
>>> + ifFalse: [^ super defaultIntegerBase]!
>>> - ^[object method methodClass defaultIntegerBaseInDebugger]
>>> - on: MessageNotUnderstood
>>> - do: [:ex| 10]!
>>>
>>> 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>>nameOfSelection (in category
>>> 'accessing - selection') -----
>>> + nameOfSelection
>>> +
>>> + ^ self typeOfSelection
>>> + caseOf: {
>>> + [#thisContext] -> ['thisContext arguments first'].
>>> + [#stackTop] -> ['thisContext arguments first top'].
>>> + [#tempVar] -> [(self slotSpecs atIndex: self selectionIndex) key] }
>>> + otherwise: [
>>> + super nameOfSelection]!
>>>
>>> Item was changed:
>>> + ----- Method: ContextVariablesInspector>>replaceSelectionValue: (in
>>> category 'code') -----
>>> - ----- Method: ContextVariablesInspector>>replaceSelectionValue: (in
>>> category 'selecting') -----
>>> replaceSelectionValue: anObject
>>> "Refer to the comment in Inspector|replaceSelectionValue:."
>>>
>>> + self typeOfSelection = #tempVar
>>> + ifFalse: [^ super replaceSelectionValue: anObject].
>>> + ^ object namedTempAt: (self selectedIndexOf: #tempVar) put: anObject!
>>> - ^selectionIndex = 1
>>> - ifTrue: [object]
>>> - ifFalse: [object namedTempAt: selectionIndex - 3 put: anObject]!
>>>
>>> Item was changed:
>>> + ----- Method: ContextVariablesInspector>>selection (in category
>>> 'accessing - selection') -----
>>> - ----- Method: ContextVariablesInspector>>selection (in category
>>> 'selecting') -----
>>> selection
>>> "Refer to the comment in Inspector|selection."
>>> + ^ self typeOfSelection
>>> - ^selectionIndex
>>> caseOf: {
>>> + [#thisContext] -> [object].
>>> + [#stackTop] -> [object actualStackSize > 0 ifTrue: [object top]
>>> ifFalse: ['']].
>>> + [#allTempVars] -> [self tempsAndValues].
>>> + [#tempVar] -> [object debuggerMap namedTempAt: (self selectedIndexOf:
>>> #tempVar) in: object] }
>>> + otherwise: [
>>> + super selection]
>>> + !
>>> - [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>>selectionIsSpecial (in
>>> category 'accessing - selection') -----
>>> + selectionIsSpecial
>>> +
>>> + ^ super selectionIsSpecial or: [self typeOfSelection = #allTempVars]!
>>>
>>> Item was added:
>>> + ----- Method: ContextVariablesInspector>>selectionUnmodifiable (in
>>> category 'accessing - selection') -----
>>> + selectionUnmodifiable
>>> +
>>> + ^ self typeOfSelection ~= #tempVar!
>>>
>>> Item was changed:
>>> + ----- Method: ContextVariablesInspector>>tempsAndValues (in category
>>> 'accessing') -----
>>> - ----- Method: ContextVariablesInspector>>tempsAndValues (in category
>>> 'selecting') -----
>>> tempsAndValues
>>> "Answer a string of the temporary variables and their current values"
>>> + | debuggerMap integerClasses |
>>> - | debuggerMap integerClasses aStream |
>>> - aStream := WriteStream on: (String new: 100).
>>> debuggerMap := object debuggerMap.
>>> integerClasses := Integer allSubclasses.
>>> + ^ Text streamContents: [:stream |
>>> (debuggerMap tempNamesForContext: object) doWithIndex:
>>> [:title :index | | temp |
>>> + stream withAttribute: TextEmphasis bold do: [
>>> + stream nextPutAll: title; nextPut: $:; space; tab; tab].
>>> - aStream nextPutAll: title; nextPut: $:; space; tab.
>>> temp := debuggerMap namedTempAt: index in: object.
>>> (integerClasses identityIndexOf: (object objectClass: temp)) ~= 0
>>> + ifTrue: [temp storeOn: stream base: self defaultIntegerBase]
>>> + ifFalse: [object print: temp on: stream].
>>> + stream cr]]!
>>> - 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 index |
>>> contextStackIndex := anInteger.
>>> anInteger = 0 ifTrue:
>>> [currentCompiledMethod := contents := nil.
>>> self changed: #contextStackIndex.
>>> self decorateButtons.
>>> self contentsChanged.
>>> contextVariablesInspector object: nil.
>>> receiverInspector object: self receiver.
>>> ^self].
>>> - selectedContextSlotName := contextVariablesInspector selectedSlotName.
>>> 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.
>>> - ((index := contextVariablesInspector fieldList indexOf:
>>> selectedContextSlotName) ~= 0
>>> - and: [index ~= contextVariablesInspector selectionIndex]) ifTrue:
>>> - [contextVariablesInspector toggleIndex: index].
>>> receiverInspector object: self receiver.
>>> isNewMethod ifFalse:
>>> [self changed: #contentsSelection]!
>>>
>>> Item was added:
>>> + ----- Method: DictionaryInspector>>addCollectionItemsTo: (in category
>>> 'menu') -----
>>> + addCollectionItemsTo: aMenu
>>> +
>>> + self typeOfSelection = #self ifFalse: [^ false].
>>> + aMenu addTranslatedList: #(
>>> + "-"
>>> + ('refresh view' refreshView)
>>> + ('add key' addEntry)).!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>addEntry (in category 'menu
>>> commands') -----
>>> - ----- Method: DictionaryInspector>>addEntry (in category 'menu') -----
>>> addEntry
>>> - | newKey aKey |
>>>
>>> + | newKey |
>>> + newKey := self requestKeyFor: '' onCancel: [^ self].
>>> + self addEntry: newKey.!
>>> - 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 changed:
>>> + ----- Method: DictionaryInspector>>addEntry: (in category 'menu
>>> commands') -----
>>> - ----- Method: DictionaryInspector>>addEntry: (in category 'selecting')
>>> -----
>>> addEntry: aKey
>>> +
>>> object at: aKey put: nil.
>>> self calculateKeyArray.
>>> + self selectKey: aKey.
>>> + self updateEntries.!
>>> - 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') -----
>>> + addFieldItemsTo: aMenu
>>> +
>>> + (super addFieldItemsTo: aMenu)
>>> + ifFalse: [^ false].
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ false].
>>> + self selectedKey isSymbol ifTrue: [
>>> + aMenu addTranslatedList: #(
>>> + ('senders of this key' sendersOfSelectedKey))].
>>> + aMenu addTranslatedList: #(
>>> + ('inspect key' inspectKey)
>>> + ('references' selectionReferences)
>>> + ('rename key' renameEntry)
>>> + ('remove key (x)' removeSelection)).
>>> + ^ true!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>calculateKeyArray (in category
>>> 'private') -----
>>> - ----- Method: DictionaryInspector>>calculateKeyArray (in category
>>> 'selecting') -----
>>> calculateKeyArray
>>> "Recalculate the KeyArray from the object being inspected"
>>>
>>> keyArray := object keysSortedSafely asArray.
>>> selectionIndex := 0.
>>> !
>>>
>>> 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="">
>>> - 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>>createSlotSpecs (in category
>>> 'accessing') -----
>>> + createSlotSpecs
>>> +
>>> + | keys |
>>> + keys := super createSlotSpecs first: 2.
>>> + keys addAll: (self truncateList: (
>>> + keyArray withIndexCollect: [:key :index |
>>> + key printString -> {#field. key}])).
>>> + ^ keys!
>>>
>>> Item was removed:
>>> - ----- Method: DictionaryInspector>>fieldList (in category 'accessing')
>>> -----
>>> - fieldList
>>> - ^ self baseFieldList
>>> - , (keyArray collect: [:key | key printString])!
>>>
>>> Item was changed:
>>> ----- Method: DictionaryInspector>>inspectKey (in category 'menu
>>> commands') -----
>>> inspectKey
>>> "Create and schedule an Inspector on the receiver's model's currently
>>> selected key."
>>>
>>> + self typeOfSelection = #field ifFalse: [^ self].
>>> + self selectedKey inspect.!
>>> - selectionIndex >= self numberOfFixedFields ifTrue:
>>> - [(keyArray at: selectionIndex - self numberOfFixedFields) inspect]!
>>>
>>> Item was added:
>>> + ----- Method: DictionaryInspector>>inspectorKey:from: (in category
>>> 'menu') -----
>>> + inspectorKey: aChar from: view
>>> +
>>> + aChar = $x
>>> + ifTrue: [self removeSelection]
>>> + ifFalse: [^ super inspectorKey: aChar from: view].
>>> + !
>>>
>>> Item was added:
>>> + ----- Method: DictionaryInspector>>inspectorOverflowText (in category
>>> 'toolbuilder') -----
>>> + inspectorOverflowText
>>> +
>>> + ^ ('<{1} elements="" at="" keys="" "{2}"="" to="" "{3}"="" not=""
>>> shown!!="">' format: {
>>> + self object size - self maximumIndicesSize.
>>> + keyArray at: self maximumIndicesSize - self minimumLastIndicesSize.
>>> + keyArray at: self object size - self minimumLastIndicesSize })
>>> + asText
>>> + addAttribute: TextEmphasis italic;
>>> + yourself!
>>>
>>> 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 added:
>>> + ----- Method: DictionaryInspector>>nameOfSelection (in category
>>> 'accessing - selection') -----
>>> + nameOfSelection
>>> +
>>> + self typeOfSelection = #field
>>> + ifFalse: [super nameOfSelection].
>>> + ^ '(self at: {1})' format: {self selectedKey}!
>>>
>>> Item was changed:
>>> ----- Method: DictionaryInspector>>numberOfFixedFields (in category
>>> 'private') -----
>>> numberOfFixedFields
>>> + self deprecated.
>>> + ^ self variableListOffset!
>>> - ^ 2 + object class instSize!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>refreshView (in category 'menu
>>> commands') -----
>>> - ----- Method: DictionaryInspector>>refreshView (in category
>>> 'selecting') -----
>>> refreshView
>>> +
>>> | i |
>>> i := selectionIndex.
>>> self calculateKeyArray.
>>> selectionIndex := i.
>>> + self updateEntries.!
>>> - self changed: #fieldList.
>>> - self changed: #contents.!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>removeSelection (in category 'menu
>>> commands') -----
>>> - ----- Method: DictionaryInspector>>removeSelection (in category
>>> 'menu') -----
>>> removeSelection
>>> +
>>> + self typeOfSelection = #field ifFalse: [^ self changed: #flash].
>>> + object removeKey: self selectedKey.
>>> - selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>> - object removeKey: (keyArray at: selectionIndex - self
>>> numberOfFixedFields).
>>> selectionIndex := 0.
>>> + self calculateKeyArray; updateEntries.!
>>> - contents := ''.
>>> - self calculateKeyArray.
>>> - self changed: #inspectObject.
>>> - self changed: #selectionIndex.
>>> - self changed: #fieldList.
>>> - self changed: #selection.!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>renameEntry (in category 'menu
>>> commands') -----
>>> - ----- Method: DictionaryInspector>>renameEntry (in category 'menu')
>>> -----
>>> renameEntry
>>> - | newKey aKey value |
>>>
>>> + | newKey |
>>> + self typeOfSelection = #field ifFalse: [^ self flash].
>>> + newKey := self requestKeyFor: self selectedKey printString onCancel:
>>> [^ self].
>>> + ^ self renameEntry: newKey!
>>> - 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>>renameEntry: (in category 'menu
>>> commands') -----
>>> + renameEntry: aKey
>>> +
>>> + object
>>> + at: aKey put: self selection;
>>> + removeKey: self selectedKey.
>>> + self calculateKeyArray; updateEntries.
>>> + self selectKey: aKey.!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>replaceSelectionValue: (in category
>>> 'code') -----
>>> + replaceSelectionValue: anObject
>>> +
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ super replaceSelectionValue: anObject].
>>> - ----- Method: DictionaryInspector>>replaceSelectionValue: (in category
>>> 'selecting') -----
>>> - replaceSelectionValue: anObject
>>> - selectionIndex <= self="">
>>> - ifTrue: [^ super replaceSelectionValue: anObject].
>>> ^ object
>>> + at: (keyArray at: selectionIndex - self variableListOffset)
>>> - at: (keyArray at: selectionIndex - self numberOfFixedFields)
>>> put: anObject!
>>>
>>> Item was added:
>>> + ----- Method: DictionaryInspector>>requestKeyFor:onCancel: (in
>>> category 'menu commands') -----
>>> + requestKeyFor: initialAnswer onCancel: aBlock
>>> +
>>> + | input |
>>> + input := UIManager default request:
>>> + 'Enter expression for new key.
>>> + (Examples: #Fred ''a string'' 3+4)'
>>> + initialAnswer: initialAnswer.
>>> + input isEmptyOrNil ifTrue: [^ aBlock value].
>>> + ^ Compiler evaluate: input!
>>>
>>> Item was added:
>>> + ----- Method: DictionaryInspector>>selectKey: (in category 'accessing
>>> - selection') -----
>>> + selectKey: aKey
>>> +
>>> + self selectionIndex: self variableListOffset + (keyArray indexOf:
>>> aKey).!
>>>
>>> Item was added:
>>> + ----- Method: DictionaryInspector>>selectedKey (in category 'accessing
>>> - selection') -----
>>> + selectedKey
>>> +
>>> + self typeOfSelection = #field ifFalse: [^ nil].
>>> + ^ self selectedIndexOf: #field!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>selection (in category 'accessing -
>>> selection') -----
>>> - ----- Method: DictionaryInspector>>selection (in category 'selecting')
>>> -----
>>> selection
>>>
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ super selection].
>>> + ^ object at: self selectedKey!
>>> - selectionIndex <= (self="" numberoffixedfields)="" iftrue:="" [^=""
>>> super="">
>>> - ^ object at: (keyArray at: selectionIndex - self numberOfFixedFields)
>>> ifAbsent:[nil]!
>>>
>>> Item was changed:
>>> + ----- Method: DictionaryInspector>>selectionReferences (in category
>>> 'menu commands') -----
>>> - ----- Method: DictionaryInspector>>selectionReferences (in category
>>> 'menu') -----
>>> selectionReferences
>>> "Create a browser on all references to the association of the current
>>> selection."
>>>
>>> + self flag: #ct "When does this work?".
>>> + self typeOfSelection = #field ifFalse: [^ self changed: #flash].
>>> + (object isMemberOf: MethodDictionary)
>>> + ifTrue: [^ self changed: #flash]. "ct: why?"
>>> + self systemNavigation browseAllCallsOn: (object associationAt: self
>>> selectedKey)!
>>> - self selectionIndex <= self="" numberoffixedfields="" iftrue:="" [^=""
>>> self="" changed:="">
>>> - 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].
>>> SystemNavigation default browseAllCallsOn: aKey!
>>>
>>> Item was added:
>>> + ----- Method: DictionaryInspector>>variableListOffset (in category
>>> 'accessing') -----
>>> + variableListOffset
>>> +
>>> + ^ 1!
>>>
>>> Item was changed:
>>> StringHolder subclass: #Inspector
>>> + instanceVariableNames: 'object selectionIndex timeOfLastListUpdate
>>> selectionUpdateTime context expression shouldStyleValuePane slotSpecs'
>>> - instanceVariableNames: 'object selectionIndex timeOfLastListUpdate
>>> selectionUpdateTime context expression shouldStyleValuePane'
>>> classVariableNames: ''
>>> poolDictionaries: ''
>>> category: 'Tools-Inspector'!
>>>
>>> !Inspector commentStamp: '' 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>>aboutToStyle:forMorph: (in category 'styling')
>>> -----
>>> aboutToStyle: aStyler forMorph: aMorph
>>>
>>> (aMorph knownName = #valuePane and: [shouldStyleValuePane not])
>>> ifTrue: [^ false].
>>>
>>> aStyler
>>> + classOrMetaClass: self object class;
>>> - classOrMetaClass: object class;
>>> parseAMethod: false.
>>> + ^ true!
>>> - ^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>>accept:notifying: (in category 'code') -----
>>> + accept: aString notifying: aController
>>> + | result |
>>> + self selectionUnmodifiable ifTrue: [
>>> + self inform: 'Selection is unmodifiable'.
>>> + ^ false].
>>> + result := self doItReceiver class evaluatorClass new
>>> + evaluate: aString
>>> + in: self doItContext
>>> + to: self doItReceiver
>>> + notifying: aController
>>> + ifFail: [^ false].
>>> + self
>>> + replaceSelectionValue: result;
>>> + update.
>>> + ^ true!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>addClassItemsTo: (in category 'menu') -----
>>> + addClassItemsTo: aMenu
>>> +
>>> + aMenu addTranslatedList: #(
>>> + ('browse full (b)' browseClass)
>>> + ('browse hierarchy (h)' classHierarchy)
>>> + ('browse protocol (p)' browseFullProtocol)).
>>> + self typeOfSelection = #self ifFalse: [^ false].
>>> + aMenu addTranslatedList: #(
>>> + -
>>> + ('references... (r)' browseVariableReferences)
>>> + ('assignments... (a)' browseVariableAssignments)
>>> + ('class refs (N)' browseClassRefs)).
>>> + ^ true!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>addCollectionItemsTo: (in category 'menu')
>>> -----
>>> - ----- 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"
>>>
>>> + | selection |
>>> + self typeOfSelection = #allInstVars ifTrue: [^ false].
>>> + selection := self selectionOrObject.
>>> + ((selection isKindOf: SequenceableCollection) and: [selection
>>> notEmpty])
>>> + ifTrue: [ aMenu addTranslatedList: #(
>>> + ('inspect element...' inspectElement)) ].
>>> + ((selection respondsTo: #inspectElement) and: [(selection isKindOf:
>>> Inspector) not])
>>> + ifTrue: [ aMenu addTranslatedList: #(
>>> + ('inspect property...' inspectMenu)) ].
>>> + ^ true!
>>> - | 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>>addFieldItemsTo: (in category 'menu') -----
>>> + addFieldItemsTo: aMenu
>>> +
>>> + ({nil. #self. #'...'} includes: self typeOfSelection)
>>> + ifTrue: [^ false].
>>> + aMenu addTranslatedList: #(
>>> + ('copy name (c)' copyName)).
>>> + ^ true!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>addInstVarItemsTo: (in category 'menu') -----
>>> + addInstVarItemsTo: aMenu
>>> +
>>> + aMenu addTranslatedList: #(
>>> + ('references... (r)' browseVariableReferences)
>>> + ('assignments... (a)' browseVariableAssignments)).
>>> + ^ true!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>addMorphicItemsTo: (in category 'menu') -----
>>> + addMorphicItemsTo: aMenu
>>> +
>>> + aMenu addTranslatedList: #(
>>> + ('tile for this value (t)' tearOffTile)
>>> + ('viewer for this value (v)' viewerForValue)).
>>> + ^ true!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>addObjectItemsTo: (in category 'menu') -----
>>> + addObjectItemsTo: aMenu
>>> +
>>> + self typeOfSelection = #'...' ifTrue: [^ false].
>>> + aMenu addTranslatedList: {
>>> + {'inspect (i)'. #inspectSelection}.
>>> + {'explore (I)'. #exploreSelection}.
>>> + {'basic inspect'. #inspectBasic. 'Inspect all instvars of the object,
>>> regardless of\any possible specialized Inspector for this type' withCRs}}.
>>> + self typeOfSelection = #allInstVars ifTrue: [^ true].
>>> + aMenu addTranslatedList: #(
>>> + -
>>> + ('objects pointing to this value' objectReferencesToSelection)
>>> + ('chase pointers' chasePointers)
>>> + ('explore pointers' explorePointers)).
>>> + ^ true!
>>>
>>> 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 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>>buildValuePaneWith: (in category 'toolbuilder')
>>> -----
>>> buildValuePaneWith: builder
>>> | textSpec |
>>> textSpec := builder pluggableCodePaneSpec new.
>>> + textSpec
>>> - textSpec
>>> model: self;
>>> name: #valuePane;
>>> + getText: #contents;
>>> + setText: #accept:notifying:;
>>> - getText: #contents;
>>> - setText: #accept:;
>>> editText: #typeValue:;
>>> help: 'Selection details.';
>>> + selection: #contentsSelection;
>>> - selection: #contentsSelection;
>>> menu: #codePaneMenu:shifted:.
>>> + ^ textSpec!
>>> - ^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: {
>>> - specs := {
>>> (0 at 0 corner: 0.3 at 0.71) -> [self buildFieldListWith: builder].
>>> (0.3 at 0.0corner: 1 at 0.71) -> [self buildValuePaneWith: builder].
>>> (LayoutFrame fractions: (0 at 0.71 corner: 1 at 1) offsets: (0 at 0 corner:
>>> buttonOffset negated at 0)) -> [self buildCodePaneWith: builder].
>>> + (LayoutFrame fractions: (1 at 0.71 corner: 1 at 1) offsets: (buttonOffset
>>> negated at 0 corner: 0 @ 0)) -> [self buildExploreButtonWith: builder].
>>> - (LayoutFrame fractions: (1 at 0.71 corner: 1 at 1) offsets: (buttonOffset
>>> negated at 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 changed:
>>> ----- Method: Inspector>>chasePointers (in category 'menu commands')
>>> -----
>>> chasePointers
>>> + | selected saved |
>>> - | selected saved |
>>> self selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>> + selected := self selectionOrObject.
>>> - selected := self selection.
>>> saved := self object.
>>> [self object: nil.
>>> (Smalltalk includesKey: #PointerFinder)
>>> ifTrue: [PointerFinder on: selected]
>>> ifFalse: [self inspectPointers]]
>>> + ensure: [self object: saved]!
>>> - ensure: [self object: saved]!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>classOfSelection (in category 'accessing -
>>> selection') -----
>>> - ----- Method: Inspector>>classOfSelection (in category 'menu
>>> commands') -----
>>> classOfSelection
>>> + self deprecated: 'Use #selectedClass'.
>>> + ^ self selectedClass!
>>> - "Answer the class of the receiver's current selection"
>>> -
>>> - self selectionUnmodifiable ifTrue: [^ object class].
>>> - ^ self selection class!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>contentsIsString (in category 'accessing -
>>> selection') -----
>>> - ----- Method: Inspector>>contentsIsString (in category 'selecting')
>>> -----
>>> contentsIsString
>>> - "Hacked so contents empty when deselected and = long printString when
>>> item 2"
>>>
>>> + ^ #(allInstVars #'...') includes: (self typeOfSelection ifNil: [^
>>> true])!
>>> - ^ (selectionIndex = 2) | (selectionIndex = 0)!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>context: (in category 'accessing') -----
>>> context: ctxt
>>> + "Set the context of inspection. Currently not in use. The inst var is
>>> here because we do primitiveChangeClassTo: between subclasses (see
>>> inspect:) between different subclasses, but also context could be used as a
>>> general concept in all inspectors"
>>> - "Set the context of inspection. 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!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>copyName (in category 'menu commands') -----
>>> copyName
>>> + "Copy the name of the selected slot into clipboard. If the selection
>>> is a collection, refer to its first element."
>>> +
>>> + | name |
>>> + name := self nameOfSelection.
>>> + "(self selection isKindOf: Collection)
>>> + ifTrue: [name := '({1} at: 1)' format: {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>>createBaseSlotSpecs (in category 'accessing')
>>> -----
>>> + createBaseSlotSpecs
>>> +
>>> + ^ OrderedDictionary newFrom: {
>>> + (SHTextStylerST80 new styledTextFor: 'self' asText) -> #self.
>>> + '*all inst vars*' asHtmlText -> #allInstVars }
>>> + , (object class allInstVarNames withIndexCollect: [:name :index |
>>> + name -> {#instVar. index}])!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>createSlotSpecs (in category 'accessing')
>>> -----
>>> + createSlotSpecs
>>> +
>>> + ^ self createBaseSlotSpecs
>>> + , (self truncateList: ((1 to: object basicSize) collect: [:i | i
>>> asString -> {#field. i}]))!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>defaultIntegerBase (in category 'accessing')
>>> -----
>>> - ----- 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 respondsTo: #defaultIntegerBaseInDebugger)
>>> + ifTrue: [object class defaultIntegerBaseInDebugger]
>>> + ifFalse: [10]!
>>> - ^[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 changed:
>>> ----- Method: Inspector>>doItReceiver (in category 'code') -----
>>> doItReceiver
>>> "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 'drag-drop')
>>> -----
>>> dragFromFieldList: index
>>> +
>>> + self selectionIndex: index.
>>> + ^ self selection!
>>> - selectionIndex = index ifFalse: [self toggleIndex: index].
>>> - ^self selection!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>dropOnFieldList:at: (in category 'drag-drop')
>>> -----
>>> dropOnFieldList: anObject at: index
>>> +
>>> + self selectionIndex: index.
>>> + self
>>> + replaceSelectionValue: anObject;
>>> + update.
>>> - selectionIndex = index ifFalse: [self toggleIndex: index].
>>> - self replaceSelectionValue: anObject.
>>> - self changed: #contents.
>>> ^ true!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>explorePointers (in category 'menu commands')
>>> -----
>>> explorePointers
>>> +
>>> + self typeOfSelection ifNil: [^ self changed: #flash].
>>> + PointerExplorer openOn: self selectionOrObject.!
>>> - self selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>> - PointerExplorer openOn: self selection.!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>exploreSelection (in category 'menu commands')
>>> -----
>>> exploreSelection
>>>
>>> + ^ self selectionOrObject explore!
>>> - self selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>> - ^ self selection explore!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>fieldList (in category 'accessing') -----
>>> fieldList
>>> "Answer the base field list plus an abbreviated list of indices."
>>>
>>> + ^ self slotSpecs keys!
>>> - object class isVariable ifFalse: [^ self baseFieldList].
>>> - ^ self baseFieldList ,
>>> - (object basicSize <= (self="" i1="" +="" self="">
>>> - 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>>generateContentsString (in category
>>> 'accessing - selection') -----
>>> + generateContentsString
>>> +
>>> + self typeOfSelection ifNil: [^ nil].
>>> + ^ self contentsIsString
>>> + ifTrue: [self selection]
>>> + ifFalse: [self selectionPrintString]!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>helpText (in category 'toolbuilder') -----
>>> - ----- Method: Inspector>>helpText (in category 'accessing') -----
>>> helpText
>>> ^ 'evaluate expressions here'!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>i1 (in category 'accessing') -----
>>> i1
>>> "This is the max index shown before skipping to the
>>> last i2 elements of very long arrays"
>>> + self deprecated.
>>> + ^ self maximumIndicesSize!
>>> - ^ 100!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>i2 (in category 'accessing') -----
>>> i2
>>> "This is the number of elements to show at the end
>>> of very long arrays"
>>> + self deprecated.
>>> + ^ self minimumLastIndicesSize!
>>> - ^ 10!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>initialExtent (in category 'toolbuilder')
>>> -----
>>> - ----- 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 'initialize-release')
>>> -----
>>> initialize
>>>
>>> selectionIndex := 0.
>>> shouldStyleValuePane := true.
>>> + slotSpecs := nil.
>>> super initialize!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>inspect: (in category 'initialize-release')
>>> -----
>>> inspect: anObject
>>> "Initialize the receiver so that it is inspecting anObject. There is no
>>> current selection.
>>>
>>> Normally the receiver will be of the correct class (as defined by
>>> anObject inspectorClass),
>>> + because it will have just been created by sending inspect to anObject.
>>> However, the
>>> - 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: (inspectorClass basicNew copyFrom:
>>> self)]].
>>> - | 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."
>>>
>>> object := anObject.
>>> self initialize!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>inspectBasic (in category 'menu commands') -----
>>> inspectBasic
>>> "Bring up a non-special inspector"
>>>
>>> + ^ self selectionOrObject basicInspect!
>>> - selectionIndex = 0 ifTrue: [^ object basicInspect].
>>> - self selection basicInspect!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>inspectElement (in category 'menu commands')
>>> -----
>>> inspectElement
>>> + | selection size choice selectionNames choiceString |
>>> - | sel selSize countString count nameStrs |
>>> "Create and schedule an Inspector on an element of the receiver's
>>> model's currently selected collection."
>>>
>>> + selection := self selectionOrObject.
>>> + (selection isKindOf: Inspector) ifTrue: [^ selection inspect].
>>> + (selection isKindOf: SequenceableCollection) ifFalse:
>>> + [^ (selection respondsTo: #inspectElement)
>>> + ifTrue: [selection inspectElement]
>>> + ifFalse: [selection inspect]].
>>> +
>>> + size := selection size.
>>> + size = 1 ifTrue: [^ selection first inspect].
>>> +
>>> + size <= 20="">
>>> + [selectionNames := selection asArray withIndexCollect: [:item :index |
>>> + '#{1}: {2}' format: {
>>> + index.
>>> + (item printStringLimitedTo: 25) replaceAll: Character cr with:
>>> Character space }].
>>> + choice := UIManager default chooseFrom: selectionNames title: 'Which
>>> element?'.
>>> + choice = 0 ifTrue: [^ self].
>>> + ^ (selection at: choice) inspect].
>>> +
>>> + choiceString := UIManager default request: 'Which element? (1 to ',
>>> size printString, ')' initialAnswer: '1'.
>>> + choiceString isEmptyOrNil ifTrue: [^ self].
>>> + selection
>>> + at: choiceString asNumber
>>> + ifPresent: [:item | ^ item inspect]
>>> + ifAbsent: [Beeper beep].!
>>> - 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="">
>>> - [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 <=>
>>> - ifTrue: [(sel at: count) inspect]
>>> - ifFalse: [Beeper beep]!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>inspectSelection (in category 'menu commands')
>>> -----
>>> inspectSelection
>>> "Create and schedule an Inspector on the receiver's model's currently
>>> selected object."
>>>
>>> + self typeOfSelection ifNil: [^ self changed: #flash].
>>> + ^ self selectionOrObject inspect!
>>> - self selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>> - self selection inspect.
>>> - ^ self selection!
>>>
>>> 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: {
>>> + [$i] -> [self inspectSelection].
>>> + [$I] -> [self exploreSelection].
>>> + [$b] -> [self browseClass].
>>> + [$h] -> [self classHierarchy].
>>> + [$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 classHierarchy].
>>> - aChar == $c ifTrue: [^ self copyName].
>>> - aChar == $p ifTrue: [^ self browseFullProtocol].
>>> - aChar == $N ifTrue: [^ self browseClassRefs].
>>> - aChar == $t ifTrue: [^ self tearOffTile].
>>> - aChar == $v ifTrue: [^ self viewerForValue].
>>> -
>>> - ^ self arrowKey: aChar from: view!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>inspectorOverflowText (in category
>>> 'toolbuilder') -----
>>> + inspectorOverflowText
>>> +
>>> + ^ ('' asText
>>> + addAttribute: TextEmphasis italic;
>>> + format: {
>>> + self maximumIndicesSize - self minimumLastIndicesSize.
>>> + (self slotSpecs atIndex: self selectionIndex + 1) value second - 1.
>>> + Smalltalk isMorphic
>>> + ifTrue: ['click here' asText
>>> + addAttribute: (PluggableTextAttribute evalBlock: [self
>>> inspectElement]);
>>> + yourself]
>>> + ifFalse: ['open the field list menu and choose "inspect element"'] })!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>instVarsPrintString (in category 'accessing')
>>> -----
>>> + instVarsPrintString
>>> +
>>> + ^ [object longPrintStringLimitedTo: 20000]
>>> + on: Error
>>> + do: [self printStringErrorText]!
>>>
>>> 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"
>>>
>>> + "gets overriden by subclasses, _without_ the "
>>> - "gets overriden by subclasses, _whithout_ the "
>>> aMenu addStayUpItemSpecial.
>>> +
>>> + self addObjectItemsTo: aMenu.
>>> -
>>> - aMenu addList: #(
>>> - ('inspect (i)' inspectSelection)
>>> - ('explore (I)' exploreSelection)).
>>> -
>>> self addCollectionItemsTo: aMenu.
>>> + aMenu addLine.
>>> + self typeOfSelection = #instVar
>>> + ifTrue: [
>>> + self addInstVarItemsTo: aMenu].
>>> + self addFieldItemsTo: aMenu.
>>> + aMenu addLine.
>>> + self addClassItemsTo: aMenu.
>>> +
>>> + (Smalltalk isMorphic and: [self selectionIsSpecial not])
>>> + ifTrue: [
>>> + aMenu addLine.
>>> + self addMorphicItemsTo: 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)' classHierarchy)
>>> - ('browse protocol (p)' browseFullProtocol)
>>> - -
>>> - ('references... (r)' browseVariableReferences)
>>> - ('assignments... (a)' browseVariableAssignments)
>>> - ('class refs (N)' browseClassRefs)
>>> - -
>>> - ('copy name (c)' copyName)
>>> - ('basic inspect' inspectBasic)).
>>> -
>>> - Smalltalk isMorphic ifTrue:
>>> - [aMenu addList: #(
>>> - -
>>> - ('tile for this value (t)' tearOffTile)
>>> - ('viewer for this value (v)' viewerForValue))].
>>> -
>>> - ^ aMenu
>>> -
>>> -
>>> - " -
>>> - ('alias for this value' aliasForValue)
>>> - ('watcher for this slot' watcherForSlot)"
>>> -
>>> - !
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>maximumIndicesSize (in category 'accessing')
>>> -----
>>> + maximumIndicesSize
>>> + "The maximum number of field slots that can be displayed. If there are
>>> more, they will be abbreviated."
>>> +
>>> + ^ 100!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>minimumLastIndicesSize (in category
>>> 'accessing') -----
>>> + minimumLastIndicesSize
>>> + "The minimum number of last slots to display if the list is
>>> abbreviated due to exceed of #maximumIndicesSize"
>>> +
>>> + ^ 10!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>modelWakeUpIn: (in category 'stepping') -----
>>> - ----- Method: Inspector>>modelWakeUpIn: (in category 'accessing') -----
>>> modelWakeUpIn: aWindow
>>> +
>>> + self
>>> + updateListsAndCodeIn: aWindow;
>>> + refreshContentsIfChanged.!
>>> - | newText |
>>> - self updateListsAndCodeIn: aWindow.
>>> - newText := self contentsIsString
>>> - ifTrue: [newText := self selection]
>>> - ifFalse: ["keep it short to reduce time to compute it"
>>> - self selectionPrintString ].
>>> - newText = contents ifFalse:
>>> - [contents := newText.
>>> - self changed: #contents]!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>nameOfSelection (in category 'accessing -
>>> selection') -----
>>> + nameOfSelection
>>> +
>>> + ^ self typeOfSelection caseOf: {
>>> + [#self] -> ['self'].
>>> + [#allInstVars] -> ['self longPrintString'].
>>> + [#instVar] -> [self selectedInstVarName].
>>> + [#field] -> ['(self basicAt: {1})' format: {self selectedObjectIndex}]
>>> + }!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>noteSelectionIndex:for: (in category
>>> 'selecting') -----
>>> - ----- Method: Inspector>>noteSelectionIndex:for: (in category
>>> 'accessing') -----
>>> noteSelectionIndex: anInteger for: aSymbol
>>> 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."
>>>
>>> + | oldSlot |
>>> - | oldSelection oldFields newFields commonFieldRange |
>>> anObject == object
>>> + ifTrue: [^ self update].
>>> + oldSlot := self selectedSlotName.
>>> + self inspect: anObject.
>>> + self changed: #inspectObject.
>>> + self selectSlotNamed: oldSlot.
>>> + self
>>> + changed: #fieldList;
>>> + changed: #contents;
>>> + changed: #helpText.!
>>> - 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 <=>
>>> - ifTrue: [oldSelection]
>>> - ifFalse: [0]).
>>> - self changed: #fieldList.
>>> - self changed: #contents.
>>> - self changed: #helpText]!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>objectReferencesToSelection (in category 'menu
>>> commands') -----
>>> objectReferencesToSelection
>>> "Open a list inspector on all the objects that point to the value of the
>>> selected instance variable, if any. "
>>>
>>> + self typeOfSelection ifNil: [^ self changed: #flash].
>>> - self selectionIndex = 0 ifTrue: [^ self changed: #flash].
>>> self systemNavigation
>>> + browseAllObjectReferencesTo: self selectionOrObject
>>> - browseAllObjectReferencesTo: self selection
>>> except: (Array with: self object)
>>> ifNone: [:obj | self changed: #flash].
>>> !
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>printStringErrorText (in category
>>> 'toolbuilder') -----
>>> - ----- Method: Inspector>>printStringErrorText (in category 'private')
>>> -----
>>> printStringErrorText
>>> +
>>> + | command |
>>> + command := self typeOfSelection = #allInstVars
>>> + ifTrue: ['self longPrintString']
>>> + ifFalse: ['{1} printString' format: {self nameOfSelection}].
>>> + ^ '<{1} evaluate="" "{2}"="" to="" debug="">' asText
>>> + addAttribute: TextColor red;
>>> + format: {
>>> + '*error in #printString:*' asHtmlText.
>>> + Smalltalk isMorphic
>>> + ifTrue: [command asText
>>> + addAttribute: (PluggableTextAttribute evalBlock: [Compiler evaluate:
>>> command for: self object]);
>>> + yourself]
>>> + ifFalse: [command] }!
>>> - | nm |
>>> - nm := self selectionIndex <>
>>> - ifTrue: ['self']
>>> - ifFalse: [self selectedSlotName].
>>> - ^ (nm
>>> - ifNil: ['no selection']
>>> - ifNotNil:
>>> - [nm first isDigit
>>> - ifTrue: ['']
>>> - ifFalse: ['
>>> 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>>refreshContentsIfChanged (in category
>>> 'updating') -----
>>> + refreshContentsIfChanged
>>> +
>>> + | newText |
>>> + newText := self generateContentsString.
>>> + newText = contents ifTrue: [^ self].
>>> +
>>> + contents := newText.
>>> + shouldStyleValuePane := false.
>>> + self changed: #contents.!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>refreshSlots (in category 'accessing') -----
>>> + refreshSlots
>>> +
>>> + slotSpecs := nil.
>>> + self changed: #fieldList.
>>> + self update.!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>replaceSelectionValue: (in category 'code')
>>> -----
>>> - ----- Method: Inspector>>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."
>>> + | instVarIndex |
>>> + self selectionUnmodifiable ifTrue: [
>>> + ^ self object].
>>> - | 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 ifFalse: [
>>> + self error: 'Cannot replace selection'].
>>> + object at: self selectedObjectIndex 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="">
>>> - 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 'morphic
>>> ui') -----
>>> representsSameBrowseeAs: anotherInspector
>>> +
>>> ^ self object == anotherInspector object!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>selectSlotNamed: (in category 'selecting')
>>> -----
>>> + selectSlotNamed: aSlotName
>>> + "Select the slot that is labeled aSlotName, or nothing, is there is no
>>> match."
>>> +
>>> + self selectionIndex: (self fieldList indexOf: aSlotName ifAbsent: [0])
>>> + !
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>selectedClass (in category 'accessing -
>>> selection') -----
>>> - ----- Method: Inspector>>selectedClass (in category 'accessing') -----
>>> selectedClass
>>> "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>>selectedIndexOf: (in category 'accessing -
>>> selection') -----
>>> + selectedIndexOf: aSymbol
>>> +
>>> + ^ (self slotSpecs atIndex: self selectionIndex) value second!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>selectedInstVarName (in category 'accessing -
>>> selection') -----
>>> + selectedInstVarName
>>> +
>>> + self typeOfSelection = #instVar ifFalse: [^ nil].
>>> + ^ self object class allInstVarNames
>>> + at: (self selectedIndexOf: #instVar)!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>selectedObjectIndex (in category 'accessing -
>>> selection') -----
>>> + selectedObjectIndex
>>> + "Answer the index of the inspectee's collection that the current
>>> selection refers to."
>>> +
>>> + ^ self selectedIndexOf: #field!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>selection (in category 'accessing -
>>> selection') -----
>>> - ----- Method: Inspector>>selection (in category 'selecting') -----
>>> selection
>>> + "Answer the value of the selected variable slot."
>>> +
>>> + ^ self typeOfSelection caseOf: {
>>> + [nil] -> [nil].
>>> + [#self] -> [object].
>>> + [#allInstVars] -> [self instVarsPrintString].
>>> + [#'...'] -> [self inspectorOverflowText].
>>> + [#instVar] -> [object instVarAt: (self selectedIndexOf: #instVar)].
>>> + [#field] -> [object basicAt: (self selectedIndexOf: #field)].
>>> + }!
>>> - "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="">
>>> - ifTrue: [^ object instVarAt: selectionIndex - 2].
>>> - basicIndex := selectionIndex - 2 - object class instSize.
>>> - (object basicSize <= (self="" i1="" +="" self="" i2)="" or:=""
>>> [basicindex=""><= self="">
>>> - ifTrue: [^ object basicAt: basicIndex]
>>> - ifFalse: [^ object basicAt: object basicSize - (self i1 + self i2) +
>>> basicIndex]!
>>>
>>> Item was changed:
>>> ----- 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 'selecting')
>>> -----
>>> + selectionIndex: anIndex
>>> +
>>> + self selectionIndex = anIndex
>>> + ifFalse: [self toggleIndex: anIndex]!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>selectionIsSpecial (in category 'accessing -
>>> selection') -----
>>> + selectionIsSpecial
>>> + "Returns whether the selected slot does not represent a real object"
>>> +
>>> + ^ #(allInstVars #'...') includes: self typeOfSelection!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>selectionOrObject (in category 'accessing -
>>> selection') -----
>>> + selectionOrObject
>>> + "My selection. If nothing useful is selected, return my inspectee
>>> instead."
>>> +
>>> + ^ ({ nil. #'...' } includes: self typeOfSelection)
>>> + ifFalse: [self selection]
>>> + ifTrue: [self object]!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>selectionPrintString (in category 'selecting')
>>> -----
>>> selectionPrintString
>>> | text |
>>> + selectionUpdateTime := [
>>> + text := [
>>> + | selection |
>>> + selection := self selection.
>>> + selection isInteger
>>> + ifTrue: [selection storeStringBase: self defaultIntegerBase]
>>> + ifFalse: [selection printStringLimitedTo: 5000]]
>>> + on: Error do: [self printStringErrorText]]
>>> + timeToRun.
>>> - 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 changed:
>>> + ----- Method: Inspector>>selectionUnmodifiable (in category 'accessing
>>> - selection') -----
>>> - ----- Method: Inspector>>selectionUnmodifiable (in category
>>> 'selecting') -----
>>> selectionUnmodifiable
>>> + "Answer if the current selected variable is modifiable via acceptance
>>> in the code pane. For example, a selection of 'self' or 'all inst vars' is
>>> unmodifiable."
>>> - "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"
>>>
>>> + ^ { nil. #self. #allInstVars. #'...' } includes: self typeOfSelection!
>>> - ^ selectionIndex <=>
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>setExpression: (in category 'accessing') -----
>>> - ----- Method: Inspector>>setExpression: (in category 'code') -----
>>> setExpression: aString
>>>
>>> self expression: aString.
>>> self changed: #expression.!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>slotSpecs (in category 'accessing') -----
>>> + slotSpecs
>>> +
>>> + ^ slotSpecs ifNil: [slotSpecs := self createSlotSpecs]!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>stepAt:in: (in category 'stepping') -----
>>> stepAt: millisecondClockValue in: aWindow
>>> - | newText |
>>>
>>> (Preferences smartUpdating and: [(millisecondClockValue - self
>>> timeOfLastListUpdate) > 8000]) "Not more often than once every 8 seconds"
>>> ifTrue:
>>> [self updateListsAndCodeIn: aWindow.
>>> timeOfLastListUpdate := millisecondClockValue].
>>>
>>> + self refreshContentsIfChanged.!
>>> - newText := self contentsIsString
>>> - ifTrue: [self selection]
>>> - ifFalse: ["keep it short to reduce time to compute it"
>>> - self selectionPrintString ].
>>> - newText = contents ifFalse:
>>> - [contents := newText.
>>> - self changed: #contents]!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>stepTimeIn: (in category 'stepping') -----
>>> - ----- Method: Inspector>>stepTimeIn: (in category 'accessing') -----
>>> stepTimeIn: aSystemWindow
>>> ^ (selectionUpdateTime ifNil: [0]) * 10 max: 1000!
>>>
>>> Item was changed:
>>> ----- 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."
>>>
>>> selectionUpdateTime := 0.
>>> selectionIndex = anInteger
>>> ifTrue:
>>> ["same index, turn off selection"
>>> selectionIndex := 0.
>>> contents := '']
>>> ifFalse:
>>> ["different index, new selection"
>>> shouldStyleValuePane := false.
>>> selectionIndex := anInteger.
>>> + contents := self generateContentsString].
>>> + self
>>> + changed: #selection;
>>> + changed: #contents;
>>> + changed: #selectionIndex.!
>>> - self contentsIsString
>>> - ifTrue: [contents := self selection]
>>> - ifFalse: [contents := self selectionPrintString]].
>>> - self changed: #selection.
>>> - self changed: #contents.
>>> - 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>>truncateList: (in category 'private') -----
>>> + truncateList: aList
>>> +
>>> + ^ aList size <= self="">
>>> + ifTrue: [aList]
>>> + ifFalse: [(aList first: self maximumIndicesSize - self
>>> minimumLastIndicesSize - 1)
>>> + , {'...' -> #'...'}
>>> + , (aList last: self minimumLastIndicesSize)]!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>typeOfSelection (in category 'accessing -
>>> selection') -----
>>> + typeOfSelection
>>> +
>>> + ^ self slotSpecs values
>>> + at: self selectionIndex
>>> + ifPresent: [:entry | entry isSymbol ifTrue: [entry] ifFalse: [entry
>>> first]]
>>> + ifAbsent: [nil]!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>typeValue: (in category 'styling') -----
>>> - ----- Method: Inspector>>typeValue: (in category 'selecting') -----
>>> typeValue: aTextOrString
>>>
>>> shouldStyleValuePane := true.
>>> self changed: #style!
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>update (in category 'updating') -----
>>> - ----- Method: Inspector>>update (in category 'accessing') -----
>>> update
>>> "Reshow contents, assuming selected value may have changed."
>>>
>>> + selectionIndex = 0 ifTrue: [^ self].
>>> + contents := self generateContentsString.
>>> + shouldStyleValuePane := false.
>>> + self
>>> + changed: #contents;
>>> + changed: #selection; flag: #ct; "Is there any update method that cares
>>> for #selection? Found none."
>>> + changed: #selectionIndex.!
>>> - selectionIndex = 0
>>> - ifFalse:
>>> - [self contentsIsString
>>> - ifTrue: [contents := self selection]
>>> - ifFalse: [contents := self selectionPrintString].
>>> - self changed: #contents.
>>> - self changed: #selection.
>>> - self changed: #selectionIndex]!
>>>
>>> Item was added:
>>> + ----- Method: Inspector>>updateEntries (in category 'accessing') -----
>>> + updateEntries
>>> +
>>> + slotSpecs := nil.
>>> + self changed: #fieldList.
>>> + self update.!
>>>
>>> Item was changed:
>>> ----- Method: Inspector>>viewerForValue (in category 'menu commands')
>>> -----
>>> viewerForValue
>>> "Open up a viewer on the value of the receiver's current selection"
>>>
>>> + self selectionOrObject beViewed!
>>> - | objectToRepresent |
>>> - objectToRepresent := self selectionIndex = 0 ifTrue: [object] ifFalse:
>>> [self selection].
>>> - objectToRepresent beViewed
>>> - !
>>>
>>> Item was changed:
>>> + ----- Method: Inspector>>wantsSteps (in category 'stepping') -----
>>> - ----- Method: Inspector>>wantsSteps (in category 'accessing') -----
>>> wantsSteps
>>> ^ true!
>>>
>>> Item was added:
>>> + ----- Method: OrderedCollectionInspector>>createSlotSpecs (in category
>>> 'accessing') -----
>>> + createSlotSpecs
>>> +
>>> + object ifNil: [ ^ OrderedDictionary new].
>>> + ^ (self createBaseSlotSpecs first: 2) , (self truncateList:
>>> + ((1 to: self objectSize) collect: [:i | i printString -> {#field.
>>> i}]))!
>>>
>>> Item was removed:
>>> - ----- Method: OrderedCollectionInspector>>fieldList (in category
>>> 'accessing') -----
>>> - fieldList
>>> - object ifNil: [ ^ OrderedCollection new].
>>> - ^ self baseFieldList ,
>>> - (self objectSize <= (self="" i1="" +="" self="">
>>> - 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 changed:
>>> ----- 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."
>>>
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ super replaceSelectionValue: anObject].
>>> + ^ object at: self selectedObjectIndex put: anObject!
>>> - (selectionIndex - 2) <= object="" class="">
>>> - 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="">
>>> - ifTrue: [basicIndex]
>>> - ifFalse: [object size - (self i1 + self i2) + basicIndex]!
>>>
>>> Item was changed:
>>> ----- 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."
>>>
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ super selection].
>>> - (selectionIndex - 2) <= object="" class="">
>>> - ifTrue: [^ super selection].
>>> ^ object at: self selectedObjectIndex!
>>>
>>> Item was added:
>>> + ----- Method: SetInspector>>addCollectionItemsTo: (in category 'menu')
>>> -----
>>> + addCollectionItemsTo: aMenu
>>> +
>>> + super addCollectionItemsTo: aMenu.
>>> + aMenu addTranslatedList: #(
>>> + ('refresh view' update)).!
>>>
>>> Item was added:
>>> + ----- Method: SetInspector>>addFieldItemsTo: (in category 'menu') -----
>>> + addFieldItemsTo: aMenu
>>> +
>>> + (super addFieldItemsTo: aMenu)
>>> + ifFalse: [^ false].
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ false].
>>> + aMenu addTranslatedList: #(
>>> + ('remove' removeSelection)).
>>> + ^ true!
>>>
>>> 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="">
>>> - ifTrue: [super copyName]
>>> - ifFalse: [sel := '(self array at: '
>>> - , (String streamContents:
>>> - [:strm | self arrayIndexForSelection storeOn: strm]) , ')'.
>>> - Clipboard clipboardText: sel asText]!
>>>
>>> Item was added:
>>> + ----- Method: SetInspector>>createSlotSpecs (in category 'accessing')
>>> -----
>>> + createSlotSpecs
>>> +
>>> + object ifNil: [^ OrderedDictionary new].
>>> + ^ (self createBaseSlotSpecs first: 2) , self itemSpecs
>>> + !
>>>
>>> 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>>inspectorOverflowText (in category
>>> 'toolbuilder') -----
>>> + inspectorOverflowText
>>> +
>>> + ^ ('<{1} more="" elements="" not="" shown!!="">' format: {self object
>>> size - self maximumIndicesSize})
>>> + asText
>>> + addAttribute: TextEmphasis italic;
>>> + yourself!
>>>
>>> Item was added:
>>> + ----- Method: SetInspector>>itemSpecs (in category 'accessing') -----
>>> + itemSpecs
>>> +
>>> + | items |
>>> + items := (object asArray
>>> + withIndexCollect: [:each :i | each ifNotNil: [i]])
>>> + select: #notNil.
>>> + ^ self truncateList: (items collect: [:each |
>>> + each asString -> {#field. each}])!
>>>
>>> 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 added:
>>> + ----- Method: SetInspector>>nameOfSelection (in category 'accessing -
>>> selection') -----
>>> + nameOfSelection
>>> +
>>> + self typeOfSelection = #field ifFalse: [
>>> + ^ super nameOfSelection].
>>> + ^ '(self array at: {1})' format: {self selectedIndexOf: #field}!
>>>
>>> Item was changed:
>>> + ----- Method: SetInspector>>removeSelection (in category 'menu
>>> commands') -----
>>> - ----- Method: SetInspector>>removeSelection (in category 'menu') -----
>>> removeSelection
>>> +
>>> + self typeOfSelection = #field ifFalse: [^ self changed: #flash].
>>> - (selectionIndex <= object="" class="" instsize)="" iftrue:="" [^=""
>>> self="" changed:="">
>>> object remove: self selection.
>>> selectionIndex := 0.
>>> + self updateEntries.!
>>> - contents := ''.
>>> - self changed: #inspectObject.
>>> - self changed: #fieldList.
>>> - self changed: #selection.
>>> - self changed: #selectionIndex.!
>>>
>>> Item was changed:
>>> + ----- Method: SetInspector>>replaceSelectionValue: (in category
>>> 'accessing - selection') -----
>>> - ----- Method: SetInspector>>replaceSelectionValue: (in category
>>> 'selecting') -----
>>> replaceSelectionValue: anObject
>>> +
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ super replaceSelectionValue: anObject].
>>> + ^ object array at: (self selectedIndexOf: #field) put: anObject!
>>> - ^ object array at: self arrayIndexForSelection put: anObject!
>>>
>>> Item was changed:
>>> + ----- Method: SetInspector>>selection (in category 'accessing -
>>> selection') -----
>>> - ----- Method: SetInspector>>selection (in category 'selecting') -----
>>> selection
>>> - selectionIndex = 0 ifTrue: [^ ''].
>>> - selectionIndex = 1 ifTrue: [^ object].
>>> - selectionIndex = 2 ifTrue: [^ object longPrintString].
>>> - (selectionIndex - 2) <= object="" class="">
>>> - ifTrue: [^ object instVarAt: selectionIndex - 2].
>>>
>>> + self typeOfSelection = #field
>>> + ifFalse: [^ super selection].
>>> + ^ object array at: (self selectedIndexOf: #field)!
>>> - ^ object array at: self arrayIndexForSelection ifAbsent: [ String
>>> empty ]!
>>>
>>> Item was changed:
>>> ----- Method: StandardToolSet class>>inspect:label: (in category
>>> 'inspecting') -----
>>> inspect: anObject label: aString
>>> "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."
>>> + ^ anObject inspectorClass openOn: anObject withLabel: aString!
>>> - ^ anObject inspectorClass openOn: anObject withEvalPane: true
>>> withLabel: aString!
>>>
>>> Item was changed:
>>> SetInspector subclass: #WeakSetInspector
>>> instanceVariableNames: 'flagObject'
>>> classVariableNames: ''
>>> poolDictionaries: ''
>>> category: 'Tools-Inspector'!
>>>
>>> + !WeakSetInspector commentStamp: 'ct 9/27/2019 19:18' prior: 0!
>>> + A version of the SetInspector specialized for inspecting WeakSets. It
>>> knows about the flag object used to indicate empty locations in the hash
>>> table.!
>>> - !WeakSetInspector commentStamp: '' prior: 0!
>>> - A verison of the SetInspector specialized for inspecting WeakSets. It
>>> knows about the flag object used to indicate empty locations in the hash
>>> table.!
>>>
>>> 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 added:
>>> + ----- Method: WeakSetInspector>>itemSpecs (in category 'accessing')
>>> -----
>>> + itemSpecs
>>> + | 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 -> {#field. i}]].
>>> +
>>> + ^ slotIndices contents!
>>>
>>>
>>>
>>>
>>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20191025/d551160d/attachment-0001.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: pastedImage.png
Type: image/png
Size: 352060 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20191025/d551160d/attachment-0002.png>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: pastedImage.png
Type: image/png
Size: 121208 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20191025/d551160d/attachment-0003.png>


More information about the Squeak-dev mailing list