The Trunk: MorphicExtras-pre.242.mcz

> 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]!
>
>