Squeak-dev November 2019

squeak-dev@lists.squeakfoundation.org

23 participants
232 discussions

The Trunk: Kernel-mt.1280.mcz
by commits＠source.squeak.org 22 Nov '19

22 Nov '19

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1280.mcz ==================== Summary ==================== Name: Kernel-mt.1280 Author: mt Time: 22 November 2019, 11:42:28.536303 am UUID: d1878463-f3d2-d248-b2d3-5b2a8d613e7b Ancestors: Kernel-mt.1279 Sorry for the noise. Boolean hick up. :-) =============== Diff against Kernel-mt.1279 =============== Item was changed: ----- Method: Deprecation class>>suppressed (in category 'accessing') ----- suppressed + ^ self showDeprecationWarnings not! - ^ self showDeprecationWarnings! Item was changed: ----- Method: Deprecation class>>suppressed: (in category 'accessing') ----- suppressed: aBoolean + self showDeprecationWarnings: aBoolean not. - self showDeprecationWarnings: aBoolean. super suppressed: aBoolean.!

1 0

The Trunk: 60Deprecated-mt.63.mcz
by commits＠source.squeak.org 22 Nov '19

22 Nov '19

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.63.mcz ==================== Summary ==================== Name: 60Deprecated-mt.63 Author: mt Time: 22 November 2019, 11:32:44.798303 am UUID: a3e51f5a-e9cd-3d4a-90c0-8b9f39b99f87 Ancestors: 60Deprecated-mt.62 Complements Kernel-mt.1279. =============== Diff against 60Deprecated-mt.62 =============== Item was added: + ----- Method: Deprecation class>>maybeSignalDeprecationFor:message:explanation: (in category '*60Deprecated-utilities') ----- + maybeSignalDeprecationFor: context message: messageString explanation: explanationString + + self flag: #deprecated. + ^ self + signalForContext: context + message: messageString + explanation: explanationString!

1 0

The Trunk: Kernel-mt.1279.mcz
by commits＠source.squeak.org 22 Nov '19

22 Nov '19

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1279.mcz ==================== Summary ==================== Name: Kernel-mt.1279 Author: mt Time: 22 November 2019, 11:32:11.080303 am UUID: 5ebf13b5-8050-7243-812f-b74e0784b215 Ancestors: Kernel-mt.1278 Following the idea in Kernel-ct.1272 (inbox/treated), add the possibility to suppress warnings. Complements Tests-mt.423. =============== Diff against Kernel-mt.1278 =============== Item was removed: - ----- Method: Deprecation class>>maybeSignalDeprecationFor:message:explanation: (in category 'utilities') ----- - maybeSignalDeprecationFor: context message: messageString explanation: explanationString - self showDeprecationWarnings ifTrue: - [ | message | - message := context method reference, ' has been deprecated', messageString, '.'. - explanationString ifNotEmpty: [message := message, ' ', explanationString]. - self signal: message].! Item was added: + ----- Method: Deprecation class>>signalForContext:message:explanation: (in category 'instance creation') ----- + signalForContext: context message: messageString explanation: explanationString + + | message | + message := context method reference, ' has been deprecated', messageString, '.'. + explanationString ifNotEmpty: [message := message, ' ', explanationString]. + self signal: message.! Item was added: + ----- Method: Deprecation class>>suppressed (in category 'accessing') ----- + suppressed + + ^ self showDeprecationWarnings! Item was added: + ----- Method: Deprecation class>>suppressed: (in category 'accessing') ----- + suppressed: aBoolean + + self showDeprecationWarnings: aBoolean. + super suppressed: aBoolean.! Item was changed: ----- Method: Object>>backwardCompatibilityOnly: (in category 'error handling') ----- backwardCompatibilityOnly: explanationString "Warn that the sending method has been deprecated. Methods that are tagt with #backwardCompatibility: are kept for compatibility." Deprecation + signalForContext: thisContext sender - maybeSignalDeprecationFor: thisContext sender message: ' (but will be kept for compatibility)' explanation: explanationString! Item was changed: ----- Method: Object>>deprecated (in category 'error handling') ----- deprecated "Warn that the sending method has been deprecated." Deprecation + signalForContext: thisContext sender - maybeSignalDeprecationFor: thisContext sender message: '' explanation: ''! Item was changed: ----- Method: Object>>deprecated: (in category 'error handling') ----- deprecated: explanationString "Warn that the sending method has been deprecated." Deprecation + signalForContext: thisContext sender - maybeSignalDeprecationFor: thisContext sender message: '' explanation: explanationString! Item was changed: ----- Method: Object>>deprecated:block: (in category 'error handling') ----- deprecated: explanationString block: aBlock "Warn that the sender has been deprecated. Answer the value of aBlock on resumption. (Note that #deprecated: is usually the preferred method.)" Deprecation + signalForContext: thisContext sender - maybeSignalDeprecationFor: thisContext sender message: '' explanation: explanationString. + ^ aBlock value - ^ aBlock value. ! Item was changed: Notification subclass: #Warning instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'! + Warning class + instanceVariableNames: 'suppressed resetOnStartUp'! !Warning commentStamp: '<historical>' prior: 0! A Warning is a Notification which by default should be brought to the attention of the user.! + Warning class + instanceVariableNames: 'suppressed resetOnStartUp'! Item was added: + ----- Method: Warning class>>cleanUp: (in category 'class initialization') ----- + cleanUp: aggressive + + aggressive ifTrue: [self resetAllWarnings].! Item was added: + ----- Method: Warning class>>initialize (in category 'class initialization') ----- + initialize + + Smalltalk addToStartUpList: self.! Item was added: + ----- Method: Warning class>>resetAllWarnings (in category 'suppress and reset') ----- + resetAllWarnings + + self withAllSubclassesDo: [:warningClass | + warningClass resetWarnings].! Item was added: + ----- Method: Warning class>>resetOnStartUp (in category 'accessing') ----- + resetOnStartUp + "If true, do not suppress this kind of warning anymore after image start up. This flag will be reset to false after doing this." + + ^ resetOnStartUp ifNil: [false]! Item was added: + ----- Method: Warning class>>resetOnStartUp: (in category 'accessing') ----- + resetOnStartUp: aBoolean + + resetOnStartUp := aBoolean.! Item was added: + ----- Method: Warning class>>resetWarnings (in category 'suppress and reset') ----- + resetWarnings + + self suppressed: false. + self resetOnStartUp: false.! Item was added: + ----- Method: Warning class>>signal (in category 'instance creation') ----- + signal + + ^ self signal: nil! Item was added: + ----- Method: Warning class>>signal: (in category 'instance creation') ----- + signal: signalerText + + ^ self suppressed + ifTrue: [nil] + ifFalse: [self new signal: signalerText]! Item was added: + ----- Method: Warning class>>startUp: (in category 'class initialization') ----- + startUp: resuming + + resuming ifTrue: [ + self withAllSubclassesDo: [:warningClass | + warningClass resetOnStartUp ifTrue: [warningClass resetWarnings]]].! Item was added: + ----- Method: Warning class>>suppressAndResetOnStartUp (in category 'suppress and reset') ----- + suppressAndResetOnStartUp + "Suppress this kind of warning but reset that after the next image start up." + + self suppressed: true. + self resetOnStartUp: true.! Item was added: + ----- Method: Warning class>>suppressWarnings (in category 'suppress and reset') ----- + suppressWarnings + "Suppress this kind of warning." + + self suppressed: true.! Item was added: + ----- Method: Warning class>>suppressed (in category 'accessing') ----- + suppressed + + ^ suppressed ifNil: [false]! Item was added: + ----- Method: Warning class>>suppressed: (in category 'accessing') ----- + suppressed: aBoolean + + suppressed := aBoolean.!

1 0

The Trunk: Tests-mt.423.mcz
by commits＠source.squeak.org 22 Nov '19

22 Nov '19

Marcel Taeumel uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-mt.423.mcz ==================== Summary ==================== Name: Tests-mt.423 Author: mt Time: 22 November 2019, 11:30:50.652303 am UUID: 0048a1fb-aa80-ad40-a372-764aee7c7c9b Ancestors: Tests-mt.422 Adds tests for Warning. =============== Diff against Tests-mt.422 =============== Item was added: + TestCase subclass: #WarningTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests-Exceptions'! Item was added: + ----- Method: WarningTests>>tearDown (in category 'running') ----- + tearDown + + Warning resetAllWarnings. + super tearDown.! Item was added: + ----- Method: WarningTests>>test01Signal (in category 'tests') ----- + test01Signal + + self should: [Warning signal] raise: Warning.! Item was added: + ----- Method: WarningTests>>test02Resume (in category 'tests') ----- + test02Resume + + self + assert: 42 + equals: ([Warning signal] on: Warning do: [:w | w resume: 42]).! Item was added: + ----- Method: WarningTests>>test03MessageText (in category 'tests') ----- + test03MessageText + + self + assert: 'Hello, World!!' + equals: ([Warning signal: 'Hello, World!!'] on: Warning do: [:w | w messageText]).! Item was added: + ----- Method: WarningTests>>test04SuppressWarnings (in category 'tests') ----- + test04SuppressWarnings + + self should: [Warning signal] raise: Warning. + Warning suppressWarnings. + self shouldnt: [Warning signal] raise: Warning.! Item was added: + ----- Method: WarningTests>>test05SuppressAndResetOnStartUp (in category 'tests') ----- + test05SuppressAndResetOnStartUp + + self should: [Warning signal] raise: Warning. + Warning suppressAndResetOnStartUp. + self shouldnt: [Warning signal] raise: Warning. + Warning startUp: true. + self should: [Warning signal] raise: Warning.! Item was added: + ----- Method: WarningTests>>test06SuppressDeprecations (in category 'tests') ----- + test06SuppressDeprecations + + self should: [self deprecated] raise: Deprecation. + Deprecation suppressWarnings. + self shouldnt: [self deprecated] raise: Deprecation.!

1 0

Very puzzling bug found trying MathMorph
by Nicola Mingotti 22 Nov '19

22 Nov '19

I was trying to see If I can use something from the MathMorphRevival project when I found this very puzzling bug. I don't understand how this can be. I hope you can enlight me. I installed MathMorph via SqueakMap, in Squeak 5.2. I run this [OK, working] > XYPlotter example2 plot asMorph openInWorld. I "Explore/Inspect" this [OK Working] > XYPlotter new I run this [Ok, no error] > |tmp| > tmp := XYPlotter new. I run this [WOW, I get an error, i am very surprised] > tmp := XYPlotter new. Can you explain me how that is at all possible ? (XYPlotter new) should be evaluated and its value (pointer) set into some dictionary in the Workspace, that Is what I thought. I see I am missing something important here. bye Nicola

1 0

I;m back !!!
by Edgar J. De Cleene 22 Nov '19

22 Nov '19

Today I decide move the server .image of squeakros.org to Linux64 and 5.3 last on ftp Steps I do: Dowload Squeak5.3alpha-19174-64bit-201911012148-Linux Expand Move SqueakV50.sources into /bin for no complains avout not to found it where Linux like. Move .image and .changes to working dir Made link to .image and put inside /shared link Move .sh launch script to Menu bar for easy work. Launch configure to my taste Adding lots of packages (hope learn new things for loooong time) Add Ladrillos with MCWorkingCopy allManagers do: [:each | each repositoryGroup addRepository: (MCHttpRepository new location: 'http://www.squeaksource.com/Ladrillos'; user: ''; password: '')] Load SqueakRosCore-edc.31 Install | loader | loader _ CodeLoader new. loader baseURL:'http://www.squeaksource.com/Ladrillos/'. loader installLastMonticelloFor: #('DynamicBindings' 'KomServices' 'KomHttpServer' 'HTML' 'HV' 'Scheduler' 'HV-Divagaciones');installSourceFiles. Troubles Can't open a button saved from 5.2 working version on Mac, later on this as is not important now First working step of the system is Divagaciones syncronizeWithWiki First you must set Divagaciones lastSynchDate: (Date fromString: '1 Jan 2019') O choose 1998 for complete swiki In the system I use Object >> createDirIfnotExists createDirIfnotExists: aDirName (FileDirectory default directoryExists:aDirName) ifFalse: [FileDirectory default createDirectory: aDirName]. ^FileDirectory default directoryNamed: aDirName I attach the failure here Sorry for the long mail. Hope feedback and someone tell me the steps for add Marcel Edgar @morplenauta

2 1

MCSaveVersionDialog splitter broken
by Nicolas Cellier 22 Nov '19

22 Nov '19

Hi, here is how to reproduce: 1. save any package 2. click on the horizontal splitter (below the list of changes) 3. the splitter goes up once at button down, and once at button up by about the vertical size of the Accept/Cancel buttons I don't know where to start searching for it...

6 15

The Inbox: Tools-ct.900.mcz
by commits＠source.squeak.org 21 Nov '19

21 Nov '19

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.ht… 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 ifTrue: - [^object instVarAt: selectionIndex - 2]. - basicIndex := selectionIndex - 2 - object class instSize. - basicIndex <= object numTemps ifTrue: - [^object debuggerMap namedTempAt: basicIndex in: object]. - basicIndex <= object stackPtr ifTrue: - [^object at: basicIndex]. - ^nil - ! Item was 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 numberOfFixedFields - ifTrue: [super copyName] - ifFalse: [sel := String streamContents: [:strm | - strm nextPutAll: '(self at: '. - (keyArray at: selectionIndex - self numberOfFixedFields) - storeOn: strm. - strm nextPutAll: ')']. - Clipboard clipboardText: sel asText "no undo allowed"]! Item was added: + ----- Method: DictionaryInspector>>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 numberOfFixedFields - 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 selection]. - ^ 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: #flash]. - object class == MethodDictionary ifTrue: [^ self changed: #flash]. - self systemNavigation browseAllCallsOn: (object associationAt: (keyArray at: selectionIndex - self numberOfFixedFields))! Item was changed: + ----- Method: DictionaryInspector>>sendersOfSelectedKey (in category 'menu commands') ----- - ----- Method: DictionaryInspector>>sendersOfSelectedKey (in category 'menu') ----- sendersOfSelectedKey "Create a browser on all senders of the selected key" + | aKey | + ((aKey := self selectedKey) isSymbol) - self selectionIndex = 0 - ifTrue: [^ self changed: #flash]. - ((aKey := keyArray at: selectionIndex - self numberOfFixedFields) isSymbol) ifFalse: [^ self changed: #flash]. 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: '<historical>' prior: 0! I represent a query path into the internal representation of an object. As a StringHolder, the string I represent is the value of the currently selected variable of the observed object.! Item was changed: ----- Method: Inspector>>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@0 corner: 0.3(a)0.71) -> [self buildFieldListWith: builder]. (0.3(a)0.0corner: 1(a)0.71) -> [self buildValuePaneWith: builder]. (LayoutFrame fractions: (0(a)0.71 corner: 1@1) offsets: (0@0 corner: buttonOffset negated@0)) -> [self buildCodePaneWith: builder]. + (LayoutFrame fractions: (1(a)0.71 corner: 1@1) offsets: (buttonOffset negated@0 corner: 0 @ 0)) -> [self buildExploreButtonWith: builder]. - (LayoutFrame fractions: (1(a)0.71 corner: 1@1) offsets: (buttonOffset negated@0 corner: 0 @ 0)) -> [self buildExploreButtonWith: builder] }. + ^ builder build: windowSpec! - - windowSpec := self buildWindowWith: builder specs: specs. - windowSpec extent: self initialExtent. - ^builder build: windowSpec! Item was 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 i2) - ifTrue: [(1 to: object basicSize) - collect: [:i | i printString]] - ifFalse: [(1 to: self i1) , (object basicSize-(self i2-1) to: object basicSize) - collect: [:i | i printString]])! Item was changed: + ----- Method: Inspector>>fieldListMenu: (in category 'menu') ----- - ----- Method: Inspector>>fieldListMenu: (in category 'menu commands') ----- fieldListMenu: aMenu "Arm the supplied menu with items for the field-list of the receiver" ^ self menu: aMenu for: #(fieldListMenu fieldListMenuShifted:) ! Item was added: + ----- Method: Inspector>>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 ifTrue: + [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 ifTrue: - [nameStrs := (1 to: selSize) asArray collect: [:ii | - ii printString, ' ', (((sel at: ii) printStringLimitedTo: 25) replaceAll: Character cr with: Character space)]. - count := UIManager default chooseFrom: (nameStrs substrings) title: 'which element?'. - count = 0 ifTrue: [^ self]. - ^ (sel at: count) inspect]. - - countString := UIManager default request: 'Which element? (1 to ', selSize printString, ')' initialAnswer: '1'. - countString isEmptyOrNil ifTrue: [^ self]. - count := Integer readFrom: (ReadStream on: countString). - (count > 0 and: [count <= selSize]) - ifTrue: [(sel at: count) inspect] - ifFalse: [Beeper beep]! Item was 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 + + ^ ('<Elements {1} to {2} not shown!! To inspect a certain element, {3}>' 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" <fieldListMenu> + "gets overriden by subclasses, _without_ the <fieldListMenu>" - "gets overriden by subclasses, _whithout_ the <fieldListMenu>" 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 <= commonFieldRange - 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 < 3 - ifTrue: ['self'] - ifFalse: [self selectedSlotName]. - ^ (nm - ifNil: ['no selection'] - ifNotNil: - [nm first isDigit - ifTrue: ['<error in printString: evaluate "(self at: ' , nm , ') printString" to debug>'] - ifFalse: ['<error in printString: evaluate "' , nm , ' printString" to debug>'] ]) asText! Item was removed: - ----- Method: Inspector>>referencesToSelection (in category 'menu commands') ----- - referencesToSelection - "Open a browser on all references to the selected instance variable, if that's what currently selected. 1/25/96 sw" - | aClass sel | - - self selectionUnmodifiable ifTrue: [^ self changed: #flash]. - (aClass := self object class) isVariable ifTrue: [^ self changed: #flash]. - - sel := aClass allInstVarNames at: self selectionIndex - 2. - self systemNavigation browseAllAccessesTo: sel from: aClass! Item was added: + ----- Method: Inspector>>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 i1]) - ifTrue: [^object basicAt: basicIndex put: anObject] - ifFalse: [^object basicAt: object basicSize - (self i1 + self i2) + basicIndex - put: anObject]! Item was changed: ----- Method: Inspector>>representsSameBrowseeAs: (in category '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 instSize - ifTrue: [^ object instVarAt: selectionIndex - 2]. - basicIndex := selectionIndex - 2 - object class instSize. - (object basicSize <= (self i1 + self i2) or: [basicIndex <= self i1]) - ifTrue: [^ object basicAt: basicIndex] - ifFalse: [^ object basicAt: object basicSize - (self i1 + self i2) + basicIndex]! Item was changed: ----- Method: Inspector>>selectionIndex (in category '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 <= 2! 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 maximumIndicesSize + 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 i2) - ifTrue: [(1 to: self objectSize) - collect: [:i | i printString]] - ifFalse: [(1 to: self i1) , (self objectSize - (self i2-1) to: self objectSize) - collect: [:i | i printString]]) - " - OrderedCollection new inspect - (OrderedCollection newFrom: #(3 5 7 123)) inspect - (OrderedCollection newFrom: (1 to: 1000)) inspect - "! Item was 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 instSize - ifTrue: [^ super replaceSelectionValue: anObject]. - object at: self selectedObjectIndex put: anObject! Item was removed: - ----- Method: OrderedCollectionInspector>>selectedObjectIndex (in category 'selecting') ----- - selectedObjectIndex - "Answer the index of the inspectee's collection that the current selection refers to." - - | basicIndex | - basicIndex := selectionIndex - 2 - object class instSize. - ^ (object size <= (self i1 + self i2) or: [basicIndex <= self i1]) - ifTrue: [basicIndex] - ifFalse: [object size - (self i1 + self i2) + basicIndex]! Item was 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 instSize - 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 instSize) - ifTrue: [super copyName] - ifFalse: [sel := '(self array at: ' - , (String streamContents: - [:strm | self arrayIndexForSelection storeOn: strm]) , ')'. - Clipboard clipboardText: sel asText]! Item was added: + ----- Method: SetInspector>>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: #flash]. 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 instSize - 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: '<historical>' prior: 0! - A verison of the SetInspector specialized for inspecting WeakSets. It knows about the flag object used to indicate empty locations in the hash table.! Item was removed: - ----- Method: WeakSetInspector>>fieldList (in category 'accessing') ----- - fieldList - | slotIndices | - object ifNil: [^ Set new]. - - "Implementation note: do not use objectArray withIndexCollect: as super - because this might collect indices in a WeakArray, leading to constantly changing fieldList - as explained at http://bugs.squeak.org/view.php?id=6812" - - slotIndices := (Array new: object size) writeStream. - object array withIndexDo: [:each :i | - (each notNil and: [each ~= flagObject]) ifTrue: [slotIndices nextPut: i printString]]. - - ^ self baseFieldList - , slotIndices contents! Item was 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!

6 11

The Trunk: Compiler-ct.404.mcz
by commits＠source.squeak.org 21 Nov '19

21 Nov '19

Marcel Taeumel uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-ct.404.mcz ==================== Summary ==================== Name: Compiler-ct.404 Author: ct Time: 17 June 2019, 10:51:02.869037 pm UUID: 19e019f5-3ff6-0143-926d-e29c155cc4be Ancestors: Compiler-eem.403 Fix a defect in Parser>>#parseCue:noPattern:ifFail: Full failure case description: Run the following statement: Compiler evaluate: '''''''' In the appearing error window, enter any valid smalltalk expression and save it. Before loading this commit, it will give you a NonBooleanError as doItFlag was set too late (and so was not passed to SyntaxErrorNotification). =============== Diff against Compiler-eem.403 =============== Item was changed: ----- Method: Parser>>parseCue:noPattern:ifFail: (in category 'public access') ----- parseCue: aCue noPattern: noPattern ifFail: aBlock "Answer a MethodNode for the argument, sourceStream, that is the root of a parse tree. Parsing is done with respect to the CompilationCue to resolve variables. Errors in parsing are reported to the cue's requestor; otherwise aBlock is evaluated. The argument noPattern is a Boolean that is true if the the sourceStream does not contain a method header (i.e., for DoIts)." | methNode repeatNeeded myStream s p subSelection | myStream := aCue sourceStream. [repeatNeeded := false. p := myStream position. s := myStream upToEnd. myStream position: p. + doitFlag := noPattern. self encoder init: aCue notifying: self. self init: myStream cue: aCue failBlock: [^ aBlock value]. subSelection := self interactive and: [cue requestor selectionInterval = (p + 1 to: p + s size)]. - doitFlag := noPattern. failBlock:= aBlock. [methNode := self method: noPattern context: cue context] on: ReparseAfterSourceEditing do: [ :ex | repeatNeeded := true. properties := nil. "Avoid accumulating pragmas and primitives Number" myStream := ex newSource ifNil: [subSelection ifTrue: [ReadStream on: cue requestor text string from: cue requestor selectionInterval first to: cue requestor selectionInterval last] ifFalse: [ReadStream on: cue requestor text string]] ifNotNil: [:src | myStream := src readStream]]. repeatNeeded] whileTrue: [encoder := self encoder class new]. methNode sourceText: s. ^methNode !

1 0

The Trunk: Compiler-ct.405.mcz
by commits＠source.squeak.org 21 Nov '19

21 Nov '19

Marcel Taeumel uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-ct.405.mcz ==================== Summary ==================== Name: Compiler-ct.405 Author: ct Time: 29 June 2019, 11:38:21.90343 pm UUID: 500db9b5-d4f6-c24e-8e91-fea4521def76 Ancestors: Compiler-ct.404 Add resumption logic to SyntaxErrorNotification =============== Diff against Compiler-eem.403 =============== Item was changed: ----- Method: Parser>>parseCue:noPattern:ifFail: (in category 'public access') ----- parseCue: aCue noPattern: noPattern ifFail: aBlock "Answer a MethodNode for the argument, sourceStream, that is the root of a parse tree. Parsing is done with respect to the CompilationCue to resolve variables. Errors in parsing are reported to the cue's requestor; otherwise aBlock is evaluated. The argument noPattern is a Boolean that is true if the the sourceStream does not contain a method header (i.e., for DoIts)." | methNode repeatNeeded myStream s p subSelection | myStream := aCue sourceStream. [repeatNeeded := false. p := myStream position. s := myStream upToEnd. myStream position: p. + doitFlag := noPattern. self encoder init: aCue notifying: self. self init: myStream cue: aCue failBlock: [^ aBlock value]. subSelection := self interactive and: [cue requestor selectionInterval = (p + 1 to: p + s size)]. - doitFlag := noPattern. failBlock:= aBlock. [methNode := self method: noPattern context: cue context] on: ReparseAfterSourceEditing do: [ :ex | repeatNeeded := true. properties := nil. "Avoid accumulating pragmas and primitives Number" myStream := ex newSource ifNil: [subSelection ifTrue: [ReadStream on: cue requestor text string from: cue requestor selectionInterval first to: cue requestor selectionInterval last] ifFalse: [ReadStream on: cue requestor text string]] ifNotNil: [:src | myStream := src readStream]]. repeatNeeded] whileTrue: [encoder := self encoder class new]. methNode sourceText: s. ^methNode ! Item was added: + ----- Method: SyntaxErrorNotification>>isResumable (in category 'accessing') ----- + isResumable + + ^ true! Item was added: + ----- Method: SyntaxErrorNotification>>resume: (in category 'accessing') ----- + resume: source + + self reparse: source notifying: nil ifFail: nil. + ^ super resumeUnchecked: self defaultResumeValue!

1 0

← Newer
1
...
7
8
9
10
11
12
13
...
24
Older →

Jump to page: