Patrick Rein uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-pre.242.mcz
==================== Summary ====================
Name: MorphicExtras-pre.242 Author: pre Time: 10 July 2018, 2:20:31.299227 pm UUID: faafe72b-0932-ae48-86bb-38dd0e666b0d Ancestors: MorphicExtras-bf.241
Makes the objects tool themeable (at least parts of it)
=============== Diff against MorphicExtras-bf.241 ===============
Item was added: + ----- Method: ObjectsTool>>baseBackgroundColor (in category 'constants') ----- + baseBackgroundColor + + ^ self userInterfaceTheme borderColor ifNil: [Color veryLightGray] !
Item was added: + ----- Method: ObjectsTool>>baseBorderColor (in category 'constants') ----- + baseBorderColor + + ^ self userInterfaceTheme borderColor ifNil: [Color veryLightGray] !
Item was changed: ----- Method: ObjectsTool>>buttonActiveColor (in category 'constants') ----- buttonActiveColor
+ ^ self userInterfaceTheme selectionTextColor ifNil: [Color white]! - ^ Color white!
Item was changed: ----- Method: ObjectsTool>>buttonColor (in category 'constants') ----- buttonColor
+ ^ self userInterfaceTheme textColor ifNil: [Color black]! - ^ Color black!
Item was changed: ----- Method: ObjectsTool>>extent: (in category 'layout') ----- extent: anExtent "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed" - self extent = anExtent ifTrue: [ ^self ]. super extent: anExtent. + self submorphsDo: [:m | + m width: anExtent x]! - self fixLayoutFrames.!
Item was changed: ----- Method: ObjectsTool>>fixLayoutFrames (in category 'layout') ----- fixLayoutFrames "Adjust the boundary between the tabs or search pane and the parts bin, giving preference to the tabs."
+ | oldY newY aTabsPane aTabsPaneHeight | + oldY := ((aTabsPane := self tabsPane - | oldY newY tp tpHeight | - oldY := ((tp := self tabsPane ifNil: [self searchPane]) ifNil: [^ self]) layoutFrame bottomOffset. + aTabsPaneHeight := aTabsPane hasSubmorphs + ifTrue: [(aTabsPane submorphBounds outsetBy: aTabsPane layoutInset) height] + ifFalse: [aTabsPane height]. + newY := (self buttonPane ifNil: [^ self]) height + aTabsPaneHeight. + oldY = newY ifTrue: [^ self]. + aTabsPane layoutFrame bottomOffset: newY. + (self partsBin ifNil: [^ self]) layoutFrame topOffset: newY. + submorphs do: [:m | m layoutChanged]! - tpHeight := tp hasSubmorphs - ifTrue: [(tp submorphBounds outsetBy: tp layoutInset) height] - ifFalse: [tp height]. - newY := (self buttonPane - ifNil: [^ self]) height + tpHeight. - oldY = newY - ifTrue: [^ self]. - tp layoutFrame bottomOffset: newY. - (self partsBin - ifNil: [^ self]) layoutFrame topOffset: newY. - submorphs - do: [:m | m layoutChanged ]!
Item was changed: ----- Method: ObjectsTool>>initializeToStandAlone (in category 'initialization') ----- initializeToStandAlone "Initialize the receiver so that it can live as a stand-alone morph" | buttonPane aBin aColor heights tabsPane | self basicInitialize. + - self layoutInset: 0; layoutPolicy: ProportionalLayout new; useRoundedCorners; hResizing: #rigid; vResizing: #rigid; extent: (self minimumWidth @ self minimumHeight).
"mode buttons" buttonPane := self paneForTabs: self modeTabs. + buttonPane color: self baseBackgroundColor. - buttonPane color: (Color r: 1 g: 0.85 b: 0.975). buttonPane vResizing: #shrinkWrap; setNameTo: 'ButtonPane'; addMorphFront: self dismissButton; addMorphBack: self helpButton; color: (aColor := buttonPane color) darker; layoutInset: 5; wrapDirection: nil; width: self width; layoutChanged; fullBounds.
"Place holder for a tabs or text pane" tabsPane := Morph new. tabsPane + color: self baseBackgroundColor; - color: (Color r: 1 g: 0.85 b: 0.975); setNameTo: 'TabPane'; hResizing: #spaceFill.
heights := { buttonPane height. 40 }.
buttonPane vResizing: #spaceFill. self addMorph: buttonPane fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0) offsets: (0 @ 0 corner: 0 @ heights first)).
self addMorph: tabsPane fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0) offsets: (0 @ heights first corner: 0 @ (heights first + heights second))).
aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #()) + changeTableLayout; listDirection: #leftToRight; wrapDirection: #topToBottom; color: aColor lighter lighter; + borderColor: aColor lighter lighter; setNameTo: 'Parts'; dropEnabled: false; vResizing: #spaceFill; yourself.
self addMorph: aBin fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ (heights first + heights second) corner: 0 @ 0)).
self borderWidth: 1; + borderColor: self baseBorderColor; + color: self baseBackgroundColor; - borderColor: (Color r: 0.9 g: 0.801 b: 0.2); - color: (Color r: 1 g: 0.85 b: 0.975); setNameTo: 'Objects' translated; showCategories. !
Item was changed: ----- Method: ObjectsTool>>paneForTabs: (in category 'tabs') ----- paneForTabs: tabList "Answer a pane bearing tabs for the given list" | aPane | tabList do: [:t | t color: Color transparent. t borderWidth: 1; borderColor: Color black].
+ aPane := Morph new + changeTableLayout; + color: self baseBackgroundColor; - aPane := AlignmentMorph newRow - color: (Color r: 1 g: 0.85 b: 0.975); listDirection: #leftToRight; wrapDirection: #topToBottom; vResizing: #spaceFill; hResizing: #spaceFill; cellInset: 6; layoutInset: 4; listCentering: #center; listSpacing: #equal; addAllMorphs: tabList; yourself.
aPane width: self layoutBounds width.
^ aPane!
Item was changed: ----- Method: PartsBin>>listDirection:quadList:buttonClass: (in category 'initialization') ----- listDirection: aListDirection quadList: quadList buttonClass: buttonClass "Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form: (<receiver> <selector> <label> <balloonHelp>) Used by external package Connectors."
self layoutPolicy: TableLayout new. self listDirection: aListDirection. self wrapCentering: #topLeft. self layoutInset: 2. self cellPositioning: #bottomCenter.
aListDirection == #leftToRight ifTrue: [self vResizing: #rigid. self hResizing: #spaceFill. self wrapDirection: #topToBottom] ifFalse: [self hResizing: #rigid. self vResizing: #spaceFill. self wrapDirection: #leftToRight]. quadList do: [:tuple | | aButton aClass | aClass := Smalltalk at: tuple first. + aButton := buttonClass new + initializeWithThumbnail: (self class thumbnailForQuad: tuple color: self color) withLabel: tuple third + andColor: self color + andSend: tuple second + to: aClass. - aButton := buttonClass new initializeWithThumbnail: (self class thumbnailForQuad: tuple color: self color) withLabel: tuple third andColor: self color andSend: tuple second to: aClass. (tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue: [aButton setBalloonText: tuple fourth]. self addMorphBack: aButton]!
packages@lists.squeakfoundation.org