Squeak-dev March 2015

squeak-dev@lists.squeakfoundation.org

40 participants
315 discussions

Speaking of all those hacks in HandMorph...
by Marcel Taeumel 04 Mar '15

04 Mar '15

Hi, there! I am just looking into all those scary hacks in HandMorph regarding drawing routings... Why? I stumbled upon GrafPort (BitBlt) #image:at:... methods and noticed that thei ignore Form >> #offset, which is important for AnimatedImageMorph (and animated GIFs). I fixed that. Then, dragging things with the hand got messed up. Let me summarize it one question: Why does HandMorph not behave like other morphs considering, #fullBounds, #changed, #position:, #fullDrawOn:, #hasDropShadow, #drawDropShadowOn:, #drawSubmorphsOn:... ? Is it or was it a performance thing? The goal is to avoid code like that: aCanvas paintImage: aForm at: aForm offset. Because only BitBlt should read #offset. Best, Marcel -- View this message in context: http://forum.world.st/Speaking-of-all-those-hacks-in-HandMorph-tp4809295.ht… Sent from the Squeak - Dev mailing list archive at Nabble.com.

2 3

Re: [squeak-dev] The Trunk: Tools-mt.534.mcz
by Tobias Pape 04 Mar '15

04 Mar '15

On 27.02.2015, at 13:20, commits(a)source.squeak.org wrote: > Marcel Taeumel uploaded a new version of Tools to project The Trunk: > http://source.squeak.org/trunk/Tools-mt.534.mcz > > ==================== Summary ==================== > > Name: Tools-mt.534 > Author: mt > Time: 27 February 2015, 2:20:38.006 pm > UUID: 32d3e256-db49-0d41-93f1-a9fa25c8d623 > Ancestors: Tools-topa.533 > > Auto-sort message category list in System Browser. Does not affect internal order of categories in class organization. Only a view thing. Makes 'alphabetize' in the menu somewhat obsolete for this column. Saves some mouse clicks. > > However, hides insertion order of message categories. Not that important, right? :-) I think there are people that care over the message category order? Why force alphabetic? Best -Tobias

7 13

List filtering broken?
by Bert Freudenberg 04 Mar '15

04 Mar '15

We used to be able to filter lists by typing a few characters. This still works, but the pane does not turn pink anymore to indicate the filtered state, and it does not revert to the full list when you mouse out. Is anyone else seeing this, or is it just broken in my image? - Bert -

5 6

The Trunk: MorphicExtras-mt.155.mcz
by commits＠source.squeak.org 03 Mar '15

03 Mar '15

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-mt.155.mcz ==================== Summary ==================== Name: MorphicExtras-mt.155 Author: mt Time: 3 March 2015, 9:29:08.112 pm UUID: c74a5771-8891-9640-9476-7dfdaf3c6f38 Ancestors: MorphicExtras-bf.154 Extended animated image morph so that it can be used with forms coming from animated gifs that only store diff/delta-frames. =============== Diff against MorphicExtras-bf.154 =============== Item was changed: ImageMorph subclass: #AnimatedImageMorph + instanceVariableNames: 'images delays stepTime nextTime imageIndex formsAreDiffs' - instanceVariableNames: 'images delays stepTime nextTime imageIndex' classVariableNames: '' poolDictionaries: '' category: 'MorphicExtras-AdditionalMorphs'! !AnimatedImageMorph commentStamp: '<historical>' prior: 0! I am an ImageMorph that can hold more than one image. Each image has its own delay time.! Item was added: + ----- Method: AnimatedImageMorph>>formsAreDiffs (in category 'accessing') ----- + formsAreDiffs + "Should the forms be drawn on top of each other to produce the frame?" + ^ formsAreDiffs ifNil: [false]! Item was added: + ----- Method: AnimatedImageMorph>>formsAreDiffs: (in category 'accessing') ----- + formsAreDiffs: aBoolean + + formsAreDiffs := aBoolean. + self reset.! Item was changed: ----- Method: AnimatedImageMorph>>fromReader: (in category 'private') ----- fromReader: reader + images := reader forms. delays := reader delays. + self reset.! - imageIndex := 0. - self image: (Form extent: images first extent depth: 32). - self step! Item was added: + ----- Method: AnimatedImageMorph>>reset (in category 'private') ----- + reset + + imageIndex := 0. + self image: (Form extent: images first extent depth: 32). + self step.! Item was changed: ----- Method: AnimatedImageMorph>>step (in category 'stepping and presenter') ----- step + | d next | - | d | images isEmpty ifTrue: [^ self]. nextTime > Time millisecondClockValue ifTrue: [^self]. self changed . + next := images at: (imageIndex := imageIndex \\ images size + 1). + self formsAreDiffs + ifFalse: [self image: next] + ifTrue: [self image getCanvas translucentImage: next at: next offset].. - self image: (images at: - (imageIndex := imageIndex \\ images size + 1)). self changed . d := (delays at: imageIndex) ifNil: [0]. nextTime := Time millisecondClockValue + d !

1 0

Re: The Inbox: Tools-mt.536.mcz
by Marcel Taeumel 02 Mar '15

02 Mar '15

<http://forum.world.st/file/n4808732/object-collection-tool.png> For such a tool to be more effective, we need to provide more drag operations in other tools such as: - Object Explorer - Senders/Implementors Browser - Versions Browser If you want to get rid of the button bars and annotation panes, just disable them in the preferences. Due to code reuse, those are the same as for regular browsers. Do we want such a tool in the trunk? Best, Marcel -- View this message in context: http://forum.world.st/The-Inbox-Tools-mt-536-mcz-tp4808731p4808732.html Sent from the Squeak - Dev mailing list archive at Nabble.com.

3 3

The Trunk: Tools-mt.537.mcz
by commits＠source.squeak.org 02 Mar '15

02 Mar '15

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.537.mcz ==================== Summary ==================== Name: Tools-mt.537 Author: mt Time: 2 March 2015, 10:41:49.215 am UUID: eb73e15d-fffe-b942-b160-5b3cf793e656 Ancestors: Tools-mt.535 Make use of proper abstractions/interface in browser models for message category selection. =============== Diff against Tools-mt.535 =============== Item was changed: ----- Method: Browser>>setClass:selector: (in category 'initialize-release') ----- setClass: aBehavior selector: aSymbol "Set the state of a new, uninitialized Browser." + | isMeta aClass | - | isMeta aClass messageCatIndex | aBehavior ifNil: [^ self]. (aBehavior isKindOf: Metaclass) ifTrue: [ isMeta := true. aClass := aBehavior soleInstance] ifFalse: [ isMeta := false. aClass := aBehavior]. + + self + selectEnvironment: aClass environment; + selectCategoryForClass: aClass; + classListIndex: (self classListIndexOf: aClass name); + metaClassIndicated: isMeta; + setSelector: aSymbol.! - self selectEnvironment: aClass environment. - self selectCategoryForClass: aClass. - self classListIndex: (self classListIndexOf: aClass name). - self metaClassIndicated: isMeta. - aSymbol ifNil: [^ self]. - messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol. - self messageCategoryListIndex: (messageCatIndex > 0 - ifTrue: [messageCatIndex + 1] - ifFalse: [0]). - messageCatIndex = 0 ifTrue: [^ self]. - self messageListIndex: ( - (aBehavior organization listAtCategoryNumber: messageCatIndex) - indexOf: aSymbol).! Item was changed: ----- Method: Browser>>setSelector: (in category 'initialize-release') ----- setSelector: aSymbol "Make the receiver point at the given selector, in the currently chosen class" + | aClass | - | aClass messageCatIndex | aSymbol ifNil: [^ self]. (aClass := self selectedClassOrMetaClass) ifNil: [^ self]. + (aClass organization categoryOfElement: aSymbol) + ifNil: [^ self] + ifNotNil: [:category | + self + selectMessageCategoryNamed: category; + selectMessageNamed: aSymbol].! - messageCatIndex := aClass organization numberOfCategoryOfElement: aSymbol. - self messageCategoryListIndex: messageCatIndex + 1. - messageCatIndex = 0 ifTrue: [^ self]. - self messageListIndex: - ((aClass organization listAtCategoryNumber: messageCatIndex) - indexOf: aSymbol)! Item was changed: ----- Method: CodeHolder>>spawnHierarchy (in category 'traits') ----- spawnHierarchy "Create and schedule a new hierarchy browser on the currently selected class or meta." + | newBrowser aSymbol selectedClassOrMetaClass | - | newBrowser aSymbol aBehavior messageCatIndex selectedClassOrMetaClass | (selectedClassOrMetaClass := self selectedClassOrMetaClass) ifNil: [^ self]. selectedClassOrMetaClass isTrait ifTrue: [^self]. newBrowser := HierarchyBrowser new initHierarchyForClass: selectedClassOrMetaClass. ((aSymbol := self selectedMessageName) notNil and: [(MessageSet isPseudoSelector: aSymbol) not]) + ifTrue: [newBrowser setSelector: aSymbol]. - ifTrue: - [aBehavior := selectedClassOrMetaClass. - messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol. - newBrowser messageCategoryListIndex: messageCatIndex + 1. - newBrowser messageListIndex: - ((aBehavior organization listAtCategoryNumber: messageCatIndex) indexOf: aSymbol)]. Browser openBrowserView: (newBrowser openSystemCatEditString: nil) label: newBrowser labelString. Smalltalk isMorphic ifTrue: ["this workaround only needed in morphic" newBrowser assureSelectionsShow]. ^ newBrowser.!

1 0

The Inbox: Tools-mt.538.mcz
by commits＠source.squeak.org 02 Mar '15

02 Mar '15

Marcel Taeumel uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-mt.538.mcz ==================== Summary ==================== Name: Tools-mt.538 Author: mt Time: 2 March 2015, 9:36:27.558 am UUID: 5ca4bf81-d7c0-0e46-ab9a-d5da652f57d3 Ancestors: Tools-topa.537 Fix ObjectCollectionTool: Dropping objects other than method/class now opens object explorer correctly for *that* object (not just "Morph new"). =============== Diff against Tools-topa.537 =============== Item was changed: ----- Method: ObjectCollectionTool>>buildWidgetForObject:then: (in category 'widgets') ----- buildWidgetForObject: anObject then: actionBlock "Fall-back if nothing more special can be found." actionBlock value: ( "Get rid of the system window." Morph new changeProportionalLayout; color: Color transparent; + addAllMorphs: (ObjectExplorer new explorerFor: anObject) paneMorphs; - addAllMorphs: (ObjectExplorer new explorerFor: Morph new) paneMorphs; yourself). !

1 0

The Inbox: Tools-topa.537.mcz
by commits＠source.squeak.org 01 Mar '15

01 Mar '15

A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-topa.537.mcz ==================== Summary ==================== Name: Tools-topa.537 Author: topa Time: 1 March 2015, 10:06:30.484 pm UUID: 0d48320d-e26c-43d7-8e8a-ca3a1cfdc918 Ancestors: Tools-mt.536 Fix Object collection tool for meta-side methods. Hint: variable name of Browser>>selectClass: classNotMeta =============== Diff against Tools-mt.536 =============== Item was changed: ----- Method: ObjectCollectionTool>>buildWidgetForCompiledMethod:then: (in category 'widgets') ----- buildWidgetForCompiledMethod: method then: actionBlock | builder spec | builder := ToolBuilder default. spec := Browser new selectSystemCategory: method methodClass category; + selectClass: method methodClass theNonMetaClass; - selectClass: method methodClass; metaClassIndicated: method methodClass isMeta; selectMessageNamed: method selector; editSelection: #editMessage; buildCodePaneWith: builder. "MethodHolder new methodClass: method methodClass methodSelector: method selector; buildCodePaneWith: builder." actionBlock value: (builder build: spec).!

1 0

The Inbox: Tools-mt.536.mcz
by commits＠source.squeak.org 01 Mar '15

01 Mar '15

Marcel Taeumel uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-mt.536.mcz ==================== Summary ==================== Name: Tools-mt.536 Author: mt Time: 1 March 2015, 9:35:39.627 pm UUID: 1ab7460c-c7be-f647-a881-9bca8ab6e605 Ancestors: Tools-mt.535 NEW TOOL: Object Collection Tool Drag and drop classes or methods from the browser into it to open mini-editors in a list. Dropping morphs will open an object explorer for that morph. ObjectCollectionTool open. =============== Diff against Tools-mt.535 =============== Item was added: + Morph subclass: #ObjectCollectionItem + instanceVariableNames: 'object' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Browser'! Item was added: + ----- Method: ObjectCollectionItem class>>on:object: (in category 'instance creation') ----- + on: aMorph object: anObject + + aMorph + hResizing: #spaceFill; + vResizing: #spaceFill. + + ^ self new + object: anObject; + addMorphFront: aMorph; + yourself! Item was added: + ----- Method: ObjectCollectionItem>>fastFramingOn (in category 'compatibility') ----- + fastFramingOn + "Compatibility with system window interface. Needed by grip morphs." + + ^ false! Item was added: + ----- Method: ObjectCollectionItem>>initialize (in category 'initialization') ----- + initialize + + super initialize. + self + height: 200; + color: Color transparent; + layoutPolicy: TableLayout new; + listDirection: #topToBottom; + hResizing: #spaceFill; + vResizing: #rigid. + + self addMorph: (BottomGripMorph new target: self).! Item was added: + ----- Method: ObjectCollectionItem>>object (in category 'accessing') ----- + object + + ^ object! Item was added: + ----- Method: ObjectCollectionItem>>object: (in category 'accessing') ----- + object: anObject + + object := anObject.! Item was added: + Morph subclass: #ObjectCollectionPane + instanceVariableNames: 'model' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Browser'! Item was added: + ----- Method: ObjectCollectionPane>>acceptDroppingMorph:event: (in category 'drag and drop') ----- + acceptDroppingMorph: aMorph event: evt + + self model + acceptDroppingMorph: aMorph + event: evt + inMorph: self.! Item was added: + ----- Method: ObjectCollectionPane>>adoptPaneColor: (in category 'accessing') ----- + adoptPaneColor: c + + self + color: c; + borderColor: c darker darker. + + super adoptPaneColor: c.! Item was added: + ----- Method: ObjectCollectionPane>>drawOn: (in category 'initialization') ----- + drawOn: aCanvas + + super drawOn: aCanvas. + + ('Drop objects here or in-between. Close editors with CMD+W.' asText + addAttribute: (TextColor color: self borderStyle color darker); + asMorph) + center: (self center x @ (self bottom - 10)); + drawOn: aCanvas.! Item was added: + ----- Method: ObjectCollectionPane>>initialize (in category 'initialization') ----- + initialize + + super initialize. + self + height: 200; + layoutPolicy: TableLayout new; + layoutInset: (0@0 corner: 0@25); + listDirection: #topToBottom; + hResizing: #spaceFill; + vResizing: #shrinkWrap; + dropEnabled: true.! Item was added: + ----- Method: ObjectCollectionPane>>model (in category 'accessing') ----- + model + + ^ model! Item was added: + ----- Method: ObjectCollectionPane>>model: (in category 'accessing') ----- + model: anObjectCollectionTool + + model := anObjectCollectionTool.! Item was added: + ----- Method: ObjectCollectionPane>>removedMorph: (in category 'submorphs-add/remove') ----- + removedMorph: anItem + + self model removeObject: anItem object.! Item was added: + ----- Method: ObjectCollectionPane>>submorphAt: (in category 'submorphs-accessing') ----- + submorphAt: position + + ^ (self morphsAt: position) + detect: [:m | self submorphs includes: m] + ifNone: []! Item was added: + ----- Method: ObjectCollectionPane>>wantsDroppedMorph:event: (in category 'drag and drop') ----- + wantsDroppedMorph: aMorph event: evt + + ^ self model + wantsDroppedMorph: aMorph + event: evt + inMorph: self! Item was added: + Model subclass: #ObjectCollectionTool + instanceVariableNames: 'objects' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Browser'! Item was added: + ----- Method: ObjectCollectionTool class>>open (in category 'instance creation') ----- + open + + ^ (ToolBuilder open: self new) model! Item was added: + ----- Method: ObjectCollectionTool class>>windowColorSpecification (in category 'instance creation') ----- + windowColorSpecification + "WindowColorRegistry refresh." + + ^ WindowColorSpec + classSymbol: self name + wording: 'Object Collection Tool' + brightColor: #lightGreen + pastelColor: #paleGreen + helpMessage: ''! Item was added: + ----- Method: ObjectCollectionTool>>acceptDroppingMorph:event:inMorph: (in category 'drag and drop') ----- + acceptDroppingMorph: transferMorph event: dropEvent inMorph: collectionPane + + | object | + object := (transferMorph respondsTo: #passenger) + ifTrue: [transferMorph passenger] + ifFalse: [transferMorph]. + self + buildWidgetFor: object + then: [:widget | + (ObjectCollectionItem on: widget object: object) in: [:newItem | + (collectionPane submorphAt: dropEvent position) + ifNil: [collectionPane addMorphBack: newItem] + ifNotNil: [:m | + dropEvent position y < m center y + ifTrue: [collectionPane addMorph: newItem inFrontOf: m] + ifFalse: [collectionPane addMorph: newItem behind: m]] ]. + self addObject: object]. + + .! Item was added: + ----- Method: ObjectCollectionTool>>addObject: (in category 'accessing - objects') ----- + addObject: anObject + + self objects add: anObject. + self changed: #labelString ! Item was added: + ----- Method: ObjectCollectionTool>>buildWidgetFor:then: (in category 'widgets') ----- + buildWidgetFor: anObject then: actionBlock + + (anObject isKindOf: CompiledMethod) + ifTrue: [^ self buildWidgetForCompiledMethod: anObject then: actionBlock]. + (anObject isKindOf: ClassDescription) + ifTrue: [^ self buildWidgetForClassDescription: anObject then: actionBlock]. + + self buildWidgetForObject: anObject then: actionBlock.! Item was added: + ----- Method: ObjectCollectionTool>>buildWidgetForClassDescription:then: (in category 'widgets') ----- + buildWidgetForClassDescription: cls then: actionBlock + + | builder spec menu | + menu := MenuMorph new + defaultTarget: [:symbol | + builder := ToolBuilder default. + spec := Browser new + selectSystemCategory: cls category; + selectClass: cls; + metaClassIndicated: (symbol = #meta); + editSelection: #editClass; + buildCodePaneWith: builder. + actionBlock value: (builder build: spec)]; + + add: cls theNonMetaClass name selector: #value: argument: #nonMeta; + add: cls theMetaClass name selector: #value: argument: #meta; + popUpAt: self currentEvent position forHand: self currentHand in: self currentWorld. + + "We need to trick the window, which will overlap the menu here." + Project current addDeferredUIMessage:[menu comeToFront].! Item was added: + ----- Method: ObjectCollectionTool>>buildWidgetForCompiledMethod:then: (in category 'widgets') ----- + buildWidgetForCompiledMethod: method then: actionBlock + + | builder spec | + builder := ToolBuilder default. + spec := Browser new + selectSystemCategory: method methodClass category; + selectClass: method methodClass; + metaClassIndicated: method methodClass isMeta; + selectMessageNamed: method selector; + editSelection: #editMessage; + buildCodePaneWith: builder. + + "MethodHolder new + methodClass: method methodClass methodSelector: method selector; + buildCodePaneWith: builder." + + actionBlock value: (builder build: spec).! Item was added: + ----- Method: ObjectCollectionTool>>buildWidgetForObject:then: (in category 'widgets') ----- + buildWidgetForObject: anObject then: actionBlock + "Fall-back if nothing more special can be found." + + actionBlock value: ( + "Get rid of the system window." + Morph new + changeProportionalLayout; + color: Color transparent; + addAllMorphs: (ObjectExplorer new explorerFor: Morph new) paneMorphs; + yourself). + ! Item was added: + ----- Method: ObjectCollectionTool>>buildWith: (in category 'toolbuilder') ----- + buildWith: builder + + | windowSpec scrollSpec morph | + windowSpec := builder pluggableWindowSpec new. + windowSpec + model: self; + label: #labelString; + children: OrderedCollection new. + + scrollSpec := builder pluggableScrollPaneSpec new. + scrollSpec + name: #scrollPane; + model: self; + hScrollBarPolicy: #never; + vScrollBarPolicy: #whenNeeded; + borderWidth: 0; + morph: (ObjectCollectionPane new + model: self; + yourself); + frame: (0@0 corner: 1@1). + windowSpec children add: scrollSpec. + + morph := builder build: windowSpec. + + "Set the layout policy for the transform morph." + (builder widgetAt: #scrollPane) scroller + layoutPolicy: TableLayout new; + color: morph paneColor darker darker. + (builder widgetAt: #scrollPane) morph + color: morph paneColor. + ActiveHand addKeyboardListener: self. + + ^ morph! Item was added: + ----- Method: ObjectCollectionTool>>defaultBackgroundColor (in category 'user interface') ----- + defaultBackgroundColor + + self flag: #refactor. "mt: Does not use the preference mechansim." + ^ Color colorFrom: self class windowColorSpecification brightColor! Item was added: + ----- Method: ObjectCollectionTool>>handleListenEvent: (in category 'events-processing') ----- + handleListenEvent: anEvent + + "Has something keyboard focus at all?" + anEvent hand keyboardFocus ifNil: [^ self]. + + "CMD+W?" + ((anEvent isKeystroke + and: [anEvent commandKeyPressed]) + and: [anEvent keyCharacter = $w]) + ifFalse: [^ self]. + + "Has keyboard?" + (anEvent hand keyboardFocus firstOwnerSuchThat: [:m | + m isSystemWindow and: [m model == self]]) + ifNil: [^ self]. + + "Which item is it?" + (anEvent hand keyboardFocus firstOwnerSuchThat: [:m | + m owner class = ObjectCollectionPane]) delete.! Item was added: + ----- Method: ObjectCollectionTool>>labelString (in category 'user interface') ----- + labelString + + ^ 'Object Collection Tool ({1})' format: {self objects size}! Item was added: + ----- Method: ObjectCollectionTool>>objects (in category 'accessing - objects') ----- + objects + + ^ objects ifNil: [objects := OrderedCollection new]! Item was added: + ----- Method: ObjectCollectionTool>>removeObject: (in category 'accessing - objects') ----- + removeObject: anObject + + self objects remove: anObject. + self changed: #labelString ! Item was added: + ----- Method: ObjectCollectionTool>>wantsDroppedMorph:event:inMorph: (in category 'drag and drop') ----- + wantsDroppedMorph: transferMorph event: dropEvent inMorph: collectionPane + + ^ collectionPane dropEnabled! Item was added: + ----- Method: ObjectCollectionTool>>windowIsClosing (in category 'updating') ----- + windowIsClosing + + ActiveHand removeKeyboardListener: self.!

1 0

The Trunk: ToolBuilder-Morphic-mt.94.mcz
by commits＠source.squeak.org 01 Mar '15

01 Mar '15

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.94.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.94 Author: mt Time: 1 March 2015, 9:19:10.471 pm UUID: 1fb0b656-e93e-2540-8164-a993206d8cce Ancestors: ToolBuilder-Morphic-mt.93 Fixed creation of pluggable scroll pane. Failed to use correct interface for #whenNeeded behavior of scroll bars. =============== Diff against ToolBuilder-Morphic-mt.93 =============== Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableScrollPane: (in category 'widgets optional') ----- buildPluggableScrollPane: spec | widget | widget := self scrollPaneClass new. widget model: spec model. self register: widget id: spec name. spec children ifNotNil: [:obj | "Create panel morph to scroll it." widget morph: (self pluggablePanelSpec new children: obj; layout: spec layout; frame: (0@0 corner: 1@1); buildWith: self). spec layout ~~ #proportional ifTrue: [ "Fix #spaceFill resizing because it does not make sense in scroll pane." widget morph hResizing: #shrinkWrap; vResizing: #shrinkWrap. widget morph submorphsDo: [:m | m extent: 100@100; flag: #refactor; "mt: Restore orginial properties?" hResizing: #rigid; vResizing: #rigid] ]] ifNil: [spec morph ifNotNil: [:m | widget morph: m] ifNil: [widget morphClass: spec morphClass]]. self setFrame: spec frame in: widget. parent ifNotNil: [self add: widget to: parent]. widget borderWidth: spec borderWidth. spec hScrollBarPolicy caseOf: { [#always] -> [widget alwaysShowHScrollBar: true]. [#never] -> [widget hideHScrollBarIndefinitely: true]. + [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded: false]}. - [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded: true]}. spec vScrollBarPolicy caseOf: { [#always] -> [widget alwaysShowVScrollBar: true]. [#never] -> [widget hideVScrollBarIndefinitely: true]. + [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded: false]}. - [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded: true]}. ^ widget!

1 0

Jump to page: