Squeak-dev October 2019

squeak-dev@lists.squeakfoundation.org

41 participants
284 discussions

Bug in Form>>#asFormOfDepth:?
by Thiede, Christoph 19 Dec '19

19 Dec '19

Hi all, consider the following example (print it): "Example 1" f := Form extent: 1 asPoint depth: 1. f colorAt: 0 @ 0 put: Color red. g := f asFormOfDepth: 2. g colorAt: 0 @ 0 Expected output: Color red. Actual output: Color black! Other examples: "Example 2" f := Form extent: 1 asPoint depth: 1. f colorAt: 0 @ 0 put: Color red. g := f asFormOfDepth: 32. g colorAt: 0 @ 0 "--> (Color r: 0.0 g: 0.0 b: 0.004)" "Example 3" f := Form extent: 1 asPoint depth: 16. f colorAt: 0 @ 0 put: Color red. g := f asFormOfDepth: 32. g colorAt: 0 @ 0 "--> (Color r: 0.973 g: 0.0 b: 0.0)" I am not familiar with color depths, but afaik Color red could be stored exactly using only 1 bit? Do I misunderstand the concept or is this really a bad output? (I came across to this when performing #collectColors: on an 8 bit ColorForm loaded from disk, which did not work as expected.) Best, Christoph

4 7

Examples of PluggableListMorph configuration
by Marcel Taeumel 13 Dec '19

13 Dec '19

Hi, all. Update your Trunk image and try this: | model view | model := SystemNavigation default allClasses collect: #name. view := PluggableListMorph on: model list: #yourself selected: nil changeSelected: nil. view extent: 200@300. view listFilterSet: 'Hand'. view openInHand. "Play around with horizontal alignment." view listMorph cellPositioning: #leftCenter. view listMorph cellPositioning: #center. view listMorph cellPositioning: #rightCenter. "Play around with margins." view listMorph cellInset: 0. view listMorph cellInset: 3@0. view listMorph cellInset: (10@5 corner: 10@5). view listMorph cellInset: (0@ -1 corner: 0 @ -1). "Fit all contents." view listMorph hResizing: #shrinkWrap; vResizing: #shrinkWrap. "always set anyway" view hResizing: #shrinkWrap; vResizing: #shrinkWrap. "Enable horizontal scrolling" view hResizing: #rigid; hScrollBarPolicy: #whenNeeded; width: 100. "Disable horizontal scrolling" view hScrollBarPolicy: #never. Best, Marcel

3 2

Adjusting the volume of a sound as it's playing
by Jim Rosenberg 08 Dec '19

08 Dec '19

Apologies in advance if this has been fixed in more recent versions of Squeak; I'm developing at the moment under Squeak 4.3. I have a project in which I'm adding sound to a longstanding body of artistic work implemented in Squeak. I'm going to need several sounds playing at once; typically there will be one or more instances of RepeatingSound and probably just one (or zero) MixedSound. When the MixedSound comes on I want to turn down the volume on the other sounds. How to do this. It has been driving me crazy. I was getting absolutely nothing to work to actually change the volume. There seems to be the right method in AbstractSound -- adjustVolumeTo:overMSecs: -- but in Squeak 4.3 this seems to not be properly overridden in MixedSound or RepeatingSound. I was getting absolutely nothing to work until I stumbled onto changing leftVols and rightVols by brute force at an explorer. This DOES WORK. leftVols and rightVols are instance variables in MixedSound, so it seems to me they should be changed by MixedSound's own implementation of adjustVolumeTo:overMSecs:. RepeatingSound should have its own implementation which just passes on to its sound. Maybe there's a better way to do this, but given that AbstractSound does have the right method, it seems like overriding here is the right thing to do. Comments? -Thanks, Jim

3 6

The Inbox: System-ct.1120.mcz
by commits＠source.squeak.org 06 Dec '19

06 Dec '19

A new version of System was added to project The Inbox: http://source.squeak.org/inbox/System-ct.1120.mcz ==================== Summary ==================== Name: System-ct.1120 Author: ct Time: 26 October 2019, 10:22:46.213469 pm UUID: 7ed0a01b-5518-e24f-9ead-65e1789c94d4 Ancestors: System-ct.1117 Revise System-ct.1117 (concerning CommonRequestStrings): Fix wrong dependency and improve code formatting =============== Diff against System-ct.1117 =============== Item was changed: ----- Method: Utilities class>>initializeCommonRequestStrings (in category 'common requests') ----- initializeCommonRequestStrings "Initialize the common request strings, a directly-editable list of expressions that can be evaluated from the 'do...' menu." CommonRequestStrings := StringHolder new contents: ( + String streamContents: [:stream | self commonRequestBlocks + do: [:block | block decompile statements + do: [:statement | stream + nextPutAll: (statement shortPrintString + copyWithRegex: '\s+' + matchesReplacedWith: String space); + nextPut: $.] + separatedBy: [stream cr]] + separatedBy: [stream cr; nextPut: $-; cr]]) - String streamContents: [:stream | - self commonRequestBlocks - do: [:block | - block decompile statements - do: [:statement | - statement veryShortPrintOn: stream. - stream nextPut: $.] - separatedBy: [stream cr]] - separatedBy: [stream cr; nextPut: $-; cr]]) "Utilities initializeCommonRequestStrings"!

4 5

Drag and drop to reorder items in a single list
by Jakob Reschke 26 Nov '19

26 Nov '19

Hello everyone, tl;dr: the current PluggableTextMorph/Plus does not support the reordering of items in a single list via drag and drop. Attached you find a change set that fixes this, but it might also break in other places. Thus, I kindly ask for a review. Today I found myself implementing a ToolBuilder-built list in which the items should be reorderable via drag and drop. Unfortunately, the current implementation of PluggableTextMorph/Plus does not allow this: you first have to drag the item out of the list before you can drop it in again. Seems like the list morph needs the mouse focus to be able to accept the drop. However, the current implementation explicitly releases the focus from the list upon grabbing the item. Then I changed the PluggableTextMorphPlus to not drop the focus, but keep it, when starting to drag an item. Now the focus would not even be released anymore when the item was indeed dragged out of a list if that list itself does not accept any drops (such as the method list in the system browser: it does not accept drops, but the methods can be dragged from it to the message categories list). So I have changed further methods to make the list morphs always handle dragging events, even if they are not interested in drops. But I do not know what else that might have broken. So, please have a look at the attached change sets. The one without "all" in the file name contains only the actual changes. The one with "all" also contains other relevant (unchanged) methods that I touched during my investigation. Eventually, I would like to put this or a revised edition of it in the inbox because list reordering via drag and drop should not be impossible. The third file contains a simple Model subclass with a list whose items should be reorderable via drag and drop, so you do not have to write it yourself. Grab a sample instance and open it with the ToolBuilder: ToolBuilder open: DragDropInSingleList new. In case I simply got it wrong and there is no need to change Morphic lists to achieve what I want, please tell me how to do it right. ;-) Best regards, Jakob

3 3

[BUG] 5.3 Alpha: No Text formatting in tree morphs
by Jakob Reschke 26 Nov '19

26 Nov '19

Hi all, It used to be that you can return a formatted Text from the method designated via the label selector of a pluggable tree. This screenshot is from Squeak 5.2: [image: image.png] In Trunk, this is broken. With the same code, the node labels are always unformatted, (except for the highlight color, which is used in ObjectExplorer, for example): [image: image.png] In case it was never supposed to work like that, how can I have Text-formatted labels in a pluggable tree in a supported way? Kind regards, Jakob Code excerpts for reference: chooserWidgetSpecs: builder ^ {builder pluggableTreeSpec new "..." label: #nodeLabelOf:; "..." nodeLabelOf: aSquotDiffNode | title | title := aSquotDiffNode title. ^ aSquotDiffNode anyChildNeedsChoice ifTrue: [(Text fromString: title) allBold; yourself] ifFalse: [title]

2 6

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 Inbox: System-kfr.1072.mcz
by commits＠source.squeak.org 21 Nov '19

21 Nov '19

A new version of System was added to project The Inbox: http://source.squeak.org/inbox/System-kfr.1072.mcz ==================== Summary ==================== Name: System-kfr.1072 Author: kfr Time: 21 July 2019, 2:25:06.897679 pm UUID: 184b8ba9-d093-584c-9409-ad52206e82b7 Ancestors: System-mt.1071 Use a subdued text color instead of plain white in community dark theme. Rename dbForeground to dbText =============== Diff against System-mt.1071 =============== Item was changed: ----- Method: CommunityTheme class>>addDarkButtons: (in category 'instance creation') ----- addDarkButtons: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #borderColor for: #PluggableButtonMorph to: Color darkGray darker ; set: #color for: #PluggableButtonMorph to: Color gray darker ; + set: #textColor for: #PluggableButtonMorph to: self dbText; - set: #textColor for: #PluggableButtonMorph to: Color white; set: #selectionModifier for: #PluggableButtonMorph to: [ [:c | self dbSelection twiceDarker] ]; + set: #hoverModifier for: #PluggableButtonMorph to: [ [:c | c adjustBrightness: -0.1] ]; + set: #feedbackModifier for: #PluggableButtonMorph to: [ [:c | c adjustBrightness: -0.1] ]. - set: #hoverModifier for: #PluggableButtonMorph to: [ [:c | c adjustBrightness: 0.2] ]; - set: #feedbackModifier for: #PluggableButtonMorph to: [ [:c | c adjustBrightness: 0.3] ]. "And the plus-version." + aUserInterfaceTheme set: #disabledTextColor for: #PluggableButtonMorphPlus to: Color gray! - aUserInterfaceTheme set: #disabledTextColor for: #PluggableButtonMorphPlus to: Color lightGray! Item was changed: ----- Method: CommunityTheme class>>addDarkMenusAndDockingBars: (in category 'instance creation') ----- addDarkMenusAndDockingBars: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #borderWidth for: #MenuMorph to: 0; set: #color for: #MenuMorph to: Color darkGray twiceDarker; + set: #titleTextColor for: #MenuMorph to: self dbText; - set: #titleTextColor for: #MenuMorph to: Color white; set: #lineColor for: #MenuMorph to: Color darkGray; set: #lineStyle for: #MenuMorph to: BorderStyle simple; set: #lineWidth for: #MenuMorph to: 1. aUserInterfaceTheme + set: #textColor for: #MenuItemMorph to: self dbText; - set: #textColor for: #MenuItemMorph to: self dbForeground; set: #selectionColor for: #MenuItemMorph to: self dbSelection; set: #selectionTextColor for: #MenuItemMorph to: Color white ; + set: #disabledTextColor for: #MenuItemMorph to: self dbText muchDarker. - set: #disabledTextColor for: #MenuItemMorph to: self dbForeground muchDarker. "set: #subMenuMarker for: #MenuItemMorph to: nil." "Use hard-coded default. See MenuItemMorph." "The world main docking bar." aUserInterfaceTheme " set: #color for: #DockingBarMorph to: Color darkGray;" " set: #selectionColor for: #DockingBarItemMorph to: self darkContentSecondary;" + set: #logoColor for: #TheWorldMainDockingBar to: self dbText; - set: #logoColor for: #TheWorldMainDockingBar to: Color white; set: #selectionLogoColor for: #TheWorldMainDockingBar to: Color white! Item was changed: ----- Method: CommunityTheme class>>addDarkScrollables: (in category 'instance creation') ----- addDarkScrollables: aUserInterfaceTheme "self createDark apply." "Scroll bars" aUserInterfaceTheme set: #thumbColor for: #ScrollBar to: self dbGray; set: #thumbBorderColor for: #ScrollBar to: self dbGray twiceDarker. "Scroll panes (includes generic stuff for list widgets, tree widgets, and text widgets." aUserInterfaceTheme set: #borderColor for: #ScrollPane to: (Color transparent) ; "So the search box isn't outlined." set: #color for: #ScrollPane to: self dbBackground. "List widgets" aUserInterfaceTheme + set: #textColor for: #PluggableListMorph to: self dbText; - set: #textColor for: #PluggableListMorph to: (Color gray: 0.9); set: #selectionColor for: #PluggableListMorph to: self dbSelection; + set: #selectionTextColor for: #PluggableListMorph to: self dbText; - set: #selectionTextColor for: #PluggableListMorph to: Color white ; derive: #multiSelectionColor for: #PluggableListMorph from: #PluggableListMorph at: #selectionColor do: [:c | c twiceDarker]; set: #filterColor for: #PluggableListMorph to: (self dbYellow alpha: 0.4); derive: #filterTextColor for: #PluggableListMorph from: #PluggableListMorph at: #textColor ; set: #preSelectionModifier for: #PluggableListMorph to: [ [:c | c twiceDarker ] ]; set: #hoverSelectionModifier for: #PluggableListMorph to: [ [:c | c twiceDarker alpha: 0.5 ] ]. "Tree widgets" aUserInterfaceTheme set: #highlightTextColor for: #SimpleHierarchicalListMorph to: self dbYellow lighter lighter; set: #lineColor for: #SimpleHierarchicalListMorph to: Color gray. "Text widgets" aUserInterfaceTheme + set: #textColor for: #PluggableTextMorph to: self dbText; - set: #textColor for: #PluggableTextMorph to: (Color gray: 0.9); set: #caretColor for: #PluggableTextMorph to: Color orange darker; set: #selectionColor for: #PluggableTextMorph to: (self dbSelection duller duller); set: #unfocusedSelectionModifier for: #PluggableTextMorph to: [ [:c | c duller] ]; set: #adornmentReadOnly for: #PluggableTextMorph to: self dbPurple; set: #adornmentRefuse for: #PluggableTextMorph to: self dbBlue; set: #adornmentConflict for: #PluggableTextMorph to: self dbRed; set: #adornmentDiff for: #PluggableTextMorph to: self dbGreen; set: #adornmentNormalEdit for: #PluggableTextMorph to: self dbOrange; set: #adornmentDiffEdit for: #PluggableTextMorph to: self dbYellow; set: #frameAdornmentWidth for: #PluggableTextMorph to: 2. aUserInterfaceTheme + set: #balloonTextColor for: #PluggableTextMorphPlus to: self dbText! - set: #balloonTextColor for: #PluggableTextMorphPlus to: Color lightGray! Item was changed: ----- Method: CommunityTheme class>>addDarkSyntaxHighlighting: (in category 'instance creation') ----- addDarkSyntaxHighlighting: aUserInterfaceTheme "self createDark apply." | normal bold italic underlined darkMap | normal := TextEmphasis normal. bold:=TextEmphasis bold. italic:=TextEmphasis italic. underlined := TextEmphasis underlined. darkMap := StrikeFont familyName: 'Darkmap DejaVu Sans' pointSize: 9. aUserInterfaceTheme set: #color for: #TextAction to: self dbBlue; + set: #default for: #SHTextStylerST80 to: {self dbText}; - set: #default for: #SHTextStylerST80 to: {self dbForeground}; set: #invalid for: #SHTextStylerST80 to: {self dbInvalid}; set: #excessCode for: #SHTextStylerST80 to: {self dbInvalid twiceDarker}; "Descriptive text for humans, italicized." set: #comment for: #SHTextStylerST80 to: {self dbComment. italic}; set: #unfinishedComment for: #SHTextStylerST80 to: {self dbComment darker. italic}; set: #'$' for: #SHTextStylerST80 to: {self dbConstant}; set: #character for: #SHTextStylerST80 to: {self dbConstant}; set: #integer for: #SHTextStylerST80 to: {self dbConstant}; set: #number for: #SHTextStylerST80 to: {self dbConstant}; + set: #- for: #SHTextStylerST80 to: {self dbText. bold}; + set: #= for: #SHTextStylerST80 to: {self dbText. bold}; - set: #- for: #SHTextStylerST80 to: {self dbForeground. bold}; - set: #= for: #SHTextStylerST80 to: {self dbForeground. bold}; set: #symbol for: #SHTextStylerST80 to: {self dbBedrock}; set: #stringSymbol for: #SHTextStylerST80 to: {self dbBedrock}; + set: #literalArray for: #SHTextStylerST80 to: {self dbText}; - set: #literalArray for: #SHTextStylerST80 to: {self dbForeground}; set: #string for: #SHTextStylerST80 to: {self dbConstant}; set: #unfinishedString for: #SHTextStylerST80 to: {self dbConstant darker}; set: #assignment for: #SHTextStylerST80 to: {nil. bold}; set: #ansiAssignment for: #SHTextStylerST80 to: {nil. bold}; set: #literal for: #SHTextStylerST80 to: {nil. bold}; set: #keyword for: #SHTextStylerST80 to: {self dbMessage}; + set: #binary for: #SHTextStylerST80 to: {self dbText. bold}; - set: #binary for: #SHTextStylerST80 to: {self dbForeground. bold}; set: #unary for: #SHTextStylerST80 to: {self dbMessage}; set: #incompleteKeyword for: #SHTextStylerST80 to: {self dbMessage darker. {underlined. bold}}; set: #incompleteBinary for: #SHTextStylerST80 to: {self dbMessage darker. underlined}; set: #incompleteUnary for: #SHTextStylerST80 to: {self dbMessage darker. underlined}; set: #undefinedKeyword for: #SHTextStylerST80 to: {self dbInvalid}; set: #undefinedBinary for: #SHTextStylerST80 to: {self dbInvalid}; set: #undefinedUnary for: #SHTextStylerST80 to: {self dbInvalid}; "Delineate the selector (good for new users), and make the method look like a mini-document with a title." set: #patternKeyword for: #SHTextStylerST80 to: {self dbMessage lighter. {bold. underlined}}; set: #patternBinary for: #SHTextStylerST80 to: {nil. bold}; set: #patternUnary for: #SHTextStylerST80 to: {self dbMessage lighter. {bold. underlined}}; set: #self for: #SHTextStylerST80 to: {self dbBedrock. bold}; set: #super for: #SHTextStylerST80 to: {self dbBedrock. bold}; set: #true for: #SHTextStylerST80 to: {self dbBedrock. bold}; set: #false for: #SHTextStylerST80 to: {self dbBedrock. bold}; set: #nil for: #SHTextStylerST80 to: {self dbBedrock. bold}; set: #thisContext for: #SHTextStylerST80 to: {self dbBedrock. bold}; + set: #return for: #SHTextStylerST80 to: {self dbText. bold}; - set: #return for: #SHTextStylerST80 to: {self dbForeground. bold}; set: #patternArg for: #SHTextStylerST80 to: {self dbSelection twiceLighter. TextEmphasis normal. "darkMap"}; set: #methodArg for: #SHTextStylerST80 to: {self dbSelection twiceLighter. TextEmphasis normal. "darkMap"}; set: #blockPatternArg for: #SHTextStylerST80 to: {self dbSelection twiceLighter}; set: #blockArg for: #SHTextStylerST80 to: {self dbSelection twiceLighter}; set: #argument for: #SHTextStylerST80 to: {self dbSelection twiceLighter}; set: #blockArgColon for: #SHTextStylerST80 to: {self dbBedrock}; set: #leftParenthesis for: #SHTextStylerST80 to: {self dbBedrock muchLighter}; set: #rightParenthesis for: #SHTextStylerST80 to: {self dbBedrock muchLighter}; set: #leftParenthesis1 for: #SHTextStylerST80 to: {self dbBedrock twiceLighter}; set: #rightParenthesis1 for: #SHTextStylerST80 to: {self dbBedrock twiceLighter}; set: #leftParenthesis2 for: #SHTextStylerST80 to: {self dbBedrock}; set: #rightParenthesis2 for: #SHTextStylerST80 to: {self dbBedrock}; set: #leftParenthesis3 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #rightParenthesis3 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #leftParenthesis4 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #rightParenthesis4 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #leftParenthesis5 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #rightParenthesis5 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #leftParenthesis6 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #rightParenthesis6 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #leftParenthesis7 for: #SHTextStylerST80 to: {Color yellow}; set: #rightParenthesis7 for: #SHTextStylerST80 to: {Color yellow}; set: #blockStart for: #SHTextStylerST80 to: {self dbBedrock muchLighter}; set: #blockEnd for: #SHTextStylerST80 to: {self dbBedrock muchLighter}; set: #blockStart1 for: #SHTextStylerST80 to: {self dbBedrock twiceLighter}; set: #blockEnd1 for: #SHTextStylerST80 to: {self dbBedrock twiceLighter}; set: #blockStart2 for: #SHTextStylerST80 to: {self dbBedrock}; set: #blockEnd2 for: #SHTextStylerST80 to: {self dbBedrock}; set: #blockStart3 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #blockEnd3 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #blockStart4 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #blockEnd4 for: #SHTextStylerST80 to: {self dbPurple muchLighter}; set: #blockStart5 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #blockEnd5 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #blockStart6 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #blockEnd6 for: #SHTextStylerST80 to: {self dbOrange muchLighter}; set: #blockStart7 for: #SHTextStylerST80 to: {Color yellow}; set: #blockEnd7 for: #SHTextStylerST80 to: {Color yellow}; set: #arrayStart for: #SHTextStylerST80 to: {self dbBedrock}; set: #arrayEnd for: #SHTextStylerST80 to: {self dbBedrock}; + set: #arrayStart1 for: #SHTextStylerST80 to: {self dbText}; + set: #arrayEnd1 for: #SHTextStylerST80 to: {self dbText}; + set: #byteArrayStart for: #SHTextStylerST80 to: {self dbText}; + set: #byteArrayEnd for: #SHTextStylerST80 to: {self dbText}; + set: #byteArrayStart1 for: #SHTextStylerST80 to: {self dbText}; + set: #byteArrayEnd1 for: #SHTextStylerST80 to: {self dbText}; + set: #leftBrace for: #SHTextStylerST80 to: {self dbText}; + set: #rightBrace for: #SHTextStylerST80 to: {self dbText}; + set: #cascadeSeparator for: #SHTextStylerST80 to: {self dbText}; + set: #statementSeparator for: #SHTextStylerST80 to: {self dbText}; + set: #externalCallType for: #SHTextStylerST80 to: {self dbText}; + set: #externalCallTypePointerIndicator for: #SHTextStylerST80 to: {self dbText}; + set: #primitiveOrExternalCallStart for: #SHTextStylerST80 to: {self dbText}; + set: #primitiveOrExternalCallEnd for: #SHTextStylerST80 to: {self dbText}; - set: #arrayStart1 for: #SHTextStylerST80 to: {self dbForeground}; - set: #arrayEnd1 for: #SHTextStylerST80 to: {self dbForeground}; - set: #byteArrayStart for: #SHTextStylerST80 to: {self dbForeground}; - set: #byteArrayEnd for: #SHTextStylerST80 to: {self dbForeground}; - set: #byteArrayStart1 for: #SHTextStylerST80 to: {self dbForeground}; - set: #byteArrayEnd1 for: #SHTextStylerST80 to: {self dbForeground}; - set: #leftBrace for: #SHTextStylerST80 to: {self dbForeground}; - set: #rightBrace for: #SHTextStylerST80 to: {self dbForeground}; - set: #cascadeSeparator for: #SHTextStylerST80 to: {self dbForeground}; - set: #statementSeparator for: #SHTextStylerST80 to: {self dbForeground}; - set: #externalCallType for: #SHTextStylerST80 to: {self dbForeground}; - set: #externalCallTypePointerIndicator for: #SHTextStylerST80 to: {self dbForeground}; - set: #primitiveOrExternalCallStart for: #SHTextStylerST80 to: {self dbForeground}; - set: #primitiveOrExternalCallEnd for: #SHTextStylerST80 to: {self dbForeground}; set: #methodTempBar for: #SHTextStylerST80 to: {self dbBedrock}; set: #blockTempBar for: #SHTextStylerST80 to: {self dbBedrock}; set: #blockArgsBar for: #SHTextStylerST80 to: {self dbBedrock}; set: #primitive for: #SHTextStylerST80 to: {self dbGreen lighter. bold}; set: #pragmaKeyword for: #SHTextStylerST80 to: {self dbGreen. bold}; set: #pragmaUnary for: #SHTextStylerST80 to: {self dbGreen. bold}; set: #pragmaBinary for: #SHTextStylerST80 to: {self dbGreen. bold}; set: #externalFunctionCallingConvention for: #SHTextStylerST80 to: {self dbGreen. bold}; set: #module for: #SHTextStylerST80 to: {self dbGreen. bold}; set: #blockTempVar for: #SHTextStylerST80 to: {self dbLocal. italic}; set: #blockPatternTempVar for: #SHTextStylerST80 to: {self dbLocal. italic}; set: #instVar for: #SHTextStylerST80 to: {self dbYellow. normal }; set: #workspaceVar for: #SHTextStylerST80 to: {self dbLocal. italic}; set: #undefinedIdentifier for: #SHTextStylerST80 to: {self dbInvalid}; set: #incompleteIdentifier for: #SHTextStylerST80 to: {self dbGray. underlined}; set: #tempVar for: #SHTextStylerST80 to: {self dbLocal. italic}; set: #patternTempVar for: #SHTextStylerST80 to: {self dbLocal. italic}; set: #poolConstant for: #SHTextStylerST80 to: {self dbConstant }; set: #classVar for: #SHTextStylerST80 to: {self dbReference}; set: #globalVar for: #SHTextStylerST80 to: {self dbClass. normal}. "And the text differ" aUserInterfaceTheme set: #insertTextAttributes for: #TextDiffBuilder to: { TextColor color: self dbRed }; set: #removeTextAttributes for: #TextDiffBuilder to: { TextEmphasis struckOut. TextColor color: self dbBlue }; set: #normalTextAttributes for: #TextDiffBuilder to: { TextEmphasis normal }.! Item was changed: ----- Method: CommunityTheme class>>addDarkWindowColors: (in category 'instance creation') ----- addDarkWindowColors: aUserInterfaceTheme "self createDark apply." aUserInterfaceTheme set: #uniformWindowColor for: #Model to: Color darkGray; set: #unfocusedWindowColorModifier for: #SystemWindow to: [ [:color | color darker] ]; + set: #unfocusedLabelColor for: #SystemWindow to: self dbText darker; + set: #focusedLabelColor for: #SystemWindow to: self dbText; - set: #unfocusedLabelColor for: #SystemWindow to: Color veryLightGray; - set: #focusedLabelColor for: #SystemWindow to: Color white; set: #customWindowColor for: #Browser to: self dbBlue; set: #customWindowColor for: #ChangeList to: self dbBlue; set: #customWindowColor for: #ChangeSorter to: self dbBlue; set: #customWindowColor for: #ChatNotes to: self dbPurple twiceDarker; set: #customWindowColor for: #ClassCommentVersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Debugger to: self dbRed; set: #customWindowColor for: #DualChangeSorter to: self dbOrange twiceDarker; set: #customWindowColor for: #FileContentsBrowser to: self dbGray; set: #customWindowColor for: #FileList to: self dbGray; set: #customWindowColor for: #Inspector to: self dbYellow duller; set: #customWindowColor for: #InstanceBrowser to: self dbYellow duller; set: #customWindowColor for: #Lexicon to: self dbGreen; set: #customWindowColor for: #MCTool to: self dbOrange twiceDarker; set: #customWindowColor for: #MessageNames to: self dbGreen; set: #customWindowColor for: #MessageSet to: self dbGreen; set: #customWindowColor for: #ObjectExplorer to: self dbYellow duller; set: #customWindowColor for: #PackagePaneBrowser to: self dbBlue; set: #customWindowColor for: #PluggableFileList to: self dbGray; set: #customWindowColor for: #PreferenceBrowser to: self dbBlue; set: #customWindowColor for: #ProcesBrowser to: self dbAqua; set: #customWindowColor for: #SMLoader to: self dbOrange twiceDarker; set: #customWindowColor for: #SMLoaderPlus to: self dbOrange twiceDarker; set: #customWindowColor for: #SMReleaseBrowser to: self dbOrange twiceDarker; set: #customWindowColor for: #ScriptingDomain to: self dbYellow duller; set: #customWindowColor for: #SelectorBrowser to: self dbBlue; set: #customWindowColor for: #StringHolder to: self dbGray; set: #customWindowColor for: #TestRunner to: self dbPink darker; set: #customWindowColor for: #TranscriptStream to: self dbGray; set: #customWindowColor for: #VersionsBrowser to: self dbPurple twiceDarker; set: #customWindowColor for: #Workspace to: self dbPink darker.! Item was changed: ----- Method: CommunityTheme class>>dbBedrock (in category 'colors by purpose') ----- dbBedrock "Basic syntactical matter which users cannot change." + ^ self dbText! - ^ self dbForeground! Item was added: + ----- Method: CommunityTheme class>>dbText (in category 'colors by purpose') ----- + dbText + "Not too bright." + ^Color r: 0.764 g: 0.776 b: 0.768!

5 6

The Inbox: Collections-mt.852.mcz
by commits＠source.squeak.org 21 Nov '19

21 Nov '19

A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-mt.852.mcz ==================== Summary ==================== Name: Collections-mt.852 Author: mt Time: 6 September 2019, 4:57:45.245608 pm UUID: 3582be1c-a006-ed46-a517-3d2d570db6cc Ancestors: Collections-mt.851 Proposal: Initialize a new collection with a computation block without needing an existing collection to #collect: from. OrderedCollection new: 20 filledWith: [100 atRandom]. Thanks to Christoph (ct) for the idea. If we want this in Trunk, there will be tests. :-) =============== Diff against Collections-mt.851 =============== Item was added: + ----- Method: ArrayedCollection class>>new:filledWith: (in category 'instance creation') ----- + new: size filledWith: aBlock + "Similar to #collect:as: and #fillFrom:with: but uses only the interval (1 to: size) to fill the collection. Different compared to #new:withAll: because aBlock can return different values for each index." + + | result | + result := self new: size. + 1 to: size do: [:each | result at: each put: (aBlock cull: each)]. + ^ result! Item was added: + ----- Method: Collection class>>new:filledWith: (in category 'instance creation') ----- + new: size filledWith: aBlock + "Similar to #collect:as: and #fillFrom:with: but uses only the interval (1 to: size) to fill the collection. Different compared to #new:withAll: because aBlock can return different values for each index." + + | result | + result := self new: size. + 1 to: size do: [:each | result add: (aBlock cull: each)]. + ^ result!

8 13

The Trunk: Morphic-mt.1582.mcz
by commits＠source.squeak.org 09 Nov '19

09 Nov '19

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1582.mcz ==================== Summary ==================== Name: Morphic-mt.1582 Author: mt Time: 23 October 2019, 3:31:24.67861 pm UUID: 82af72b9-4198-4bd2-8e7e-e8733d9018c7 Ancestors: Morphic-mt.1581 Adds things for column-specific list filtering: - backgroundColor for LazyListMorph - optional filter-term indication for LazyListMorph - column highlights for multi-column lists - Character tab to cycle between columns Note that I opted to not use the [space] key for column toggling because (a) we have to widget-focus cycling via [tab] at the moment and (b) the space character might be a valuable filter term. =============== Diff against Morphic-mt.1581 =============== Item was changed: Morph subclass: #LazyListMorph + instanceVariableNames: 'listItems listIcons listFilterOffsets font selectedRow selectedRows preSelectedRow listSource maxWidth columnIndex iconExtent backgroundColor showFilter' - instanceVariableNames: 'listItems listIcons listFilterOffsets font selectedRow selectedRows preSelectedRow listSource maxWidth columnIndex iconExtent' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Widgets'! !LazyListMorph commentStamp: 'mt 10/13/2019 19:44' prior: 0! The morph that displays the list in a PluggableListMorph. It is "lazy" because it will only request the list items that it actually needs to display. I will cache the maximum width of my items in maxWidth to avoid this potentially expensive and frequent computation. The following layout properties are supported: - #cellPositioning: #leftCenter [default], #center, #rightCenter - #cellInset: [default: 3@0 corner: 3@0]! Item was added: + ----- Method: LazyListMorph>>backgroundColor (in category 'accessing') ----- + backgroundColor + "Since #color is this morph's default text color, this extra property is used for the actual background color. Supports nil." + + ^ backgroundColor! Item was added: + ----- Method: LazyListMorph>>backgroundColor: (in category 'accessing') ----- + backgroundColor: aColor + + backgroundColor = aColor ifTrue: [^ self]. + backgroundColor := aColor. + + self changed. + "Invalidate owner because we want to fill the vertical axis in the viewport entirely." + self owner ifNotNil: [:o | o changed].! Item was changed: ----- Method: LazyListMorph>>displayFilterOn:for:in:font: (in category 'drawing') ----- displayFilterOn: canvas for: row in: drawBounds font: font "Draw filter matches if any." | fillStyle fillHeight | + self showFilter ifFalse: [^ self]. - listSource filterableList ifFalse: [^ self]. fillHeight := font height. fillStyle := self filterColor isColor ifTrue: [SolidFillStyle color: self filterColor] ifFalse: [self filterColor]. fillStyle isGradientFill ifTrue: [ fillStyle origin: drawBounds topLeft. fillStyle direction: 0@ fillHeight]. (self filterOffsets: row) do: [:offset | | highlightRectangle | highlightRectangle := ((drawBounds left + offset first first) @ drawBounds top corner: (drawBounds left + offset first last) @ (drawBounds top + fillHeight)). canvas frameAndFillRoundRect: (highlightRectangle outsetBy: 1@0) radius: (3 * RealEstateAgent scaleFactor) truncated fillStyle: fillStyle borderWidth: (1 * RealEstateAgent scaleFactor) truncated borderColor: fillStyle asColor twiceDarker. canvas drawString: offset second in: highlightRectangle font: font color: self filterTextColor].! Item was changed: ----- Method: LazyListMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | topRow bottomRow | + self backgroundColor ifNotNil: [:color | + aCanvas fillRectangle: (self topLeft corner: self right @ ((self owner ifNil: [self]) bottom)) color: color]. + self getListSize = 0 ifTrue: [ ^self ]. self drawPreSelectionOn: aCanvas. topRow := self topVisibleRowForCanvas: aCanvas. bottomRow := self bottomVisibleRowForCanvas: aCanvas. "Draw multi-selection." self listSource hasMultiSelection ifTrue: [ topRow to: bottomRow do: [ :row | (self listSource itemSelectedAmongMultiple: row) ifTrue: [ self drawBackgroundForMulti: row on: aCanvas ] ] ]. self drawSelectionOn: aCanvas. "Draw hovered row if preference enabled." PluggableListMorph highlightHoveredRow ifTrue: [ self listSource hoverRow > 0 ifTrue: [ self highlightHoverRow: listSource hoverRow on: aCanvas ] ]. "Draw all visible rows." topRow to: bottomRow do: [ :row | self display: (self item: row) atRow: row on: aCanvas ]. "Finally, highlight drop row for drag/drop operations.." self listSource potentialDropRow > 0 ifTrue: [ self highlightPotentialDropRow: self listSource potentialDropRow on: aCanvas ].! Item was added: + ----- Method: LazyListMorph>>showFilter (in category 'accessing') ----- + showFilter + + ^ (showFilter ~~ false and: [listSource filterableList])! Item was added: + ----- Method: LazyListMorph>>showFilter: (in category 'accessing') ----- + showFilter: aBoolean + + showFilter = aBoolean ifTrue: [^ self]. + showFilter := aBoolean. + self changed.! Item was added: + ----- Method: PluggableMultiColumnListMorph>>filterColumnColor (in category 'filtering') ----- + filterColumnColor + + ^ (Color gray: 0.85) alpha: 0.4! Item was added: + ----- Method: PluggableMultiColumnListMorph>>filterColumnIndex (in category 'filtering') ----- + filterColumnIndex + "Which column to apply the filter to?" + + | i | + i := 0. + self listMorphs + detect: [:m | i := i + 1. m backgroundColor notNil] + ifNone: [i := 0]. + ^ i! Item was added: + ----- Method: PluggableMultiColumnListMorph>>filterList:columnIndex:matching: (in category 'filtering') ----- + filterList: columns columnIndex: index matching: aPattern + "A matching row has a match in at least one column." + + | frontMatching substringMatching rowCount columnCount tmp | + aPattern ifEmpty: [^ columns]. + columns ifEmpty: [^ columns]. + + rowCount := columns first size. + rowCount = 0 ifTrue: [^ columns]. + columnCount := columns size. + + frontMatching := Array new: columnCount. + 1 to: columnCount do: [:c | frontMatching at: c put: OrderedCollection new]. + substringMatching := Array new: columnCount. + 1 to: columnCount do: [:c | substringMatching at: c put: OrderedCollection new]. + + modelToView := Dictionary new. + viewToModel := Dictionary new. + tmp := OrderedCollection new. + + 1 to: rowCount do: [:rowIndex | + | match foundPos | + match := false. + foundPos := self + filterListItem: ((columns at: index) at: rowIndex) + matching: aPattern. + foundPos = 1 + ifTrue: [ + 1 to: columnCount do: [:colIndex | + (frontMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)]. + modelToView at: rowIndex put: frontMatching first size. + viewToModel at: frontMatching first size put: rowIndex] + ifFalse: [foundPos > 1 ifTrue: [ + 1 to: columnCount do: [:colIndex | + (substringMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)]. + tmp add: rowIndex; add: substringMatching first size]] + ]. + + tmp pairsDo: [:modelIndex :viewIndex | + modelToView at: modelIndex put: viewIndex + frontMatching first size. + viewToModel at: viewIndex + frontMatching first size put: modelIndex]. + + ^ (1 to: columnCount) collect: [:colIndex | + (frontMatching at: colIndex), (substringMatching at: colIndex)] + + + + + + + + + + + + + + ! Item was changed: ----- Method: PluggableMultiColumnListMorph>>filterList:matching: (in category 'filtering') ----- filterList: columns matching: aPattern "A matching row has a match in at least one column." | frontMatching substringMatching rowCount columnCount tmp | aPattern ifEmpty: [^ columns]. columns ifEmpty: [^ columns]. + "Enable column-specific filtering." + self filterColumnIndex in: [:index | + index > 0 ifTrue: [^ self filterList: columns columnIndex: index matching: aPattern]]. + rowCount := columns first size. rowCount = 0 ifTrue: [^ columns]. columnCount := columns size. frontMatching := Array new: columnCount. 1 to: columnCount do: [:c | frontMatching at: c put: OrderedCollection new]. substringMatching := Array new: columnCount. 1 to: columnCount do: [:c | substringMatching at: c put: OrderedCollection new]. modelToView := Dictionary new. viewToModel := Dictionary new. tmp := OrderedCollection new. 1 to: rowCount do: [:rowIndex | | match foundPos | match := false. foundPos := 0. 1 to: columnCount do: [:colIndex | match := match or: [(foundPos := (self filterListItem: ((columns at: colIndex) at: rowIndex) matching: aPattern)+colIndex) > colIndex]]. match & (foundPos = 2) "means front match in first column" ifTrue: [ 1 to: columnCount do: [:colIndex | (frontMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)]. modelToView at: rowIndex put: frontMatching first size. viewToModel at: frontMatching first size put: rowIndex] ifFalse: [match ifTrue: [ 1 to: columnCount do: [:colIndex | (substringMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)]. tmp add: rowIndex; add: substringMatching first size]] ]. tmp pairsDo: [:modelIndex :viewIndex | modelToView at: modelIndex put: viewIndex + frontMatching first size. viewToModel at: viewIndex + frontMatching first size put: modelIndex]. ^ (1 to: columnCount) collect: [:colIndex | (frontMatching at: colIndex), (substringMatching at: colIndex)] ! Item was added: + ----- Method: PluggableMultiColumnListMorph>>highlightNextColumn (in category 'filtering') ----- + highlightNextColumn + + | i currentColumn nextColumn | + i := self filterColumnIndex. + i = 0 ifTrue: [self listMorphs do: [:m | m showFilter: false]]. + + currentColumn := self listMorphs at: (i max: 1). + nextColumn := self listMorphs at: i \\ self listMorphs size + 1. + + currentColumn + showFilter: false; + backgroundColor: nil. + + nextColumn + showFilter: true; + backgroundColor: self filterColumnColor.! Item was added: + ----- Method: PluggableMultiColumnListMorph>>highlightNoColumn (in category 'filtering') ----- + highlightNoColumn + + self listMorphs do: [:m | + m showFilter: true; backgroundColor: nil].! Item was added: + ----- Method: PluggableMultiColumnListMorph>>removeFilter (in category 'filtering') ----- + removeFilter + + self highlightNoColumn. + super removeFilter. + ! Item was added: + ----- Method: PluggableMultiColumnListMorph>>specialKeyPressed: (in category 'filtering') ----- + specialKeyPressed: asciiValue + "Use the [Tab] key to filter specific columns." + + ^ asciiValue = Character tab asciiValue + ifTrue: [self highlightNextColumn] + ifFalse: [super specialKeyPressed: asciiValue].! Item was changed: ----- Method: PluggableMultiColumnListMorph>>updateColumns (in category 'updating') ----- updateColumns "The number of columns must match the number of list morphs." | columnsChanged | columnsChanged := self columnCount ~= listMorphs size. [self columnCount < listMorphs size] whileTrue: [ listMorphs removeLast delete]. [self columnCount > listMorphs size] whileTrue: [ listMorphs addLast: self createListMorph. self scroller addMorphBack: listMorphs last]. listMorphs doWithIndex: [:listMorph :columnIndex | listMorph columnIndex: columnIndex; + color: self textColor; cellPositioning: (self cellPositioningAtColumn: columnIndex); cellInset: (self cellInsetAtColumn: columnIndex); hResizing: (self hResizingAtColumn: columnIndex); spaceFillWeight: (self spaceFillWeightAtColumn: columnIndex)]. columnsChanged ifTrue: [self setListParameters].!

4 5

← Newer
1
2
3
4
5
6
7
...
29
Older →

Jump to page: