[squeak-dev] The Trunk: MorphicExtras-pre.242.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jul 10 12:21:26 UTC 2018


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



More information about the Squeak-dev mailing list