[Pkg] The Trunk: Morphic-mt.1560.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Oct 8 15:00:03 UTC 2019


Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1560.mcz

==================== Summary ====================

Name: Morphic-mt.1560
Author: mt
Time: 8 October 2019, 4:59:55.753299 pm
UUID: d6aa14b7-4dfb-eb44-bde5-0ea41cb097e5
Ancestors: Morphic-mt.1559

Found and fixed more layout bugs due to the latest new tests. :-)

- Avoid unnecessary re-layouts in scroll panes
- Use an actual layout policy to drive PluggableTextMorph's scroller and text morph (POSTSCRIPT converts all existing text fields)
- Fix a bug with #shrinkWrap for owners that have children with children but no layout policy

=============== Diff against Morphic-mt.1559 ===============

Item was removed:
- ----- Method: BorderGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	super layoutProportionallyIn: cellBounds.
- 	
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct properties at this time."
- 	self orientation = #vertical ifTrue: [
- 		self width: self class gripThickness + (self owner borderWidth * 2)].
- 	self orientation = #horizontal ifTrue: [
- 		self height: self class gripThickness + (self owner borderWidth * 2)].
- !

Item was added:
+ ----- Method: BorderGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 
+ 	super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
+ 	
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct properties at this time."
+ 	self orientation = #vertical ifTrue: [
+ 		self width: self class gripThickness + (self owner borderWidth * 2)].
+ 	self orientation = #horizontal ifTrue: [
+ 		self height: self class gripThickness + (self owner borderWidth * 2)].
+ !

Item was removed:
- ----- Method: BottomGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	super layoutProportionallyIn: cellBounds.
- 	
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self bottom: owner bottom.!

Item was added:
+ ----- Method: BottomGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 
+ 	super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
+ 	
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self bottom: owner bottom.!

Item was removed:
- ----- Method: BottomLeftGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self bottomLeft: owner bottomLeft.!

Item was added:
+ ----- Method: BottomLeftGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self bottomLeft: owner bottomLeft.!

Item was removed:
- ----- Method: BottomRightGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self bottomRight: owner bottomRight.!

Item was added:
+ ----- Method: BottomRightGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self bottomRight: owner bottomRight.!

Item was removed:
- ----- Method: LeftGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	super layoutProportionallyIn: cellBounds.
- 	
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self left: owner left.
- 	
- 	self top: owner top.
- 	self height: owner height.!

Item was added:
+ ----- Method: LeftGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: cellBounds positioning: cellPositioning
+ 
+ 	super layoutProportionallyInBounds: cellBounds positioning: cellPositioning.
+ 	
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self left: owner left.
+ 	
+ 	self top: owner top.
+ 	self height: owner height.!

Item was added:
+ ----- Method: MenuItemMorph>>doLayoutIn: (in category 'layout') -----
+ doLayoutIn: layoutBounds
+ 	"Since we have no layout policy, make sure to compute the fullBounds right manually. Maybe we could also override #submorphBoundsForShrinkWrap, but since we have no submorphs, #adjustLayoutBounds is never called..."
+ 	
+ 	self hResizing = #shrinkWrap
+ 		ifTrue: [self width: self minWidth].
+ 	self vResizing = #shrinkWrap
+ 		ifTrue: [self height: self minHeight].
+ 
+ 	super doLayoutIn: layoutBounds.!

Item was changed:
  ----- Method: Morph>>layoutInBounds: (in category 'layout') -----
  layoutInBounds: cellBounds
- 	"Layout specific. Apply the given bounds to the receiver after being layed out in its owner."
  	
+ 	self flag: #deprecated. "No actual deprecation warning because of debugging hazards."
+ 	self
+ 		layoutInBounds: cellBounds
+ 		positioning: (self owner ifNil: [#center] ifNotNil: [:o | o cellPositioning]).!
- 	| box aSymbol |	
- 	"1) We are getting new bounds here but we haven't computed the receiver's layout yet."
- 	self layoutComputed ifFalse:[
- 		"Although the receiver has reported its #minExtent before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints (see #adjustLayoutBounds) then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds."
- 		
- 		"1.1) Adjust the box for #rigid receiver. Both #spaceFill and #shrinkWrap can use the cellBounds for now, which is important for many space-fills in a row or column to have the same widths (or heights) such as all MenuMorphItems in our MenuMorph."
- 		box := cellBounds origin extent: 
- 			(self hResizing == #rigid ifTrue: [self bounds extent x] ifFalse: [cellBounds extent x]) @
- 			(self vResizing == #rigid ifTrue: [self bounds extent y] ifFalse: [cellBounds extent y]).
- 		
- 		"1.2) Move and resize the receiver to get started."
- 		self
- 			setPositionFromLayout: box origin;
- 			setExtentFromLayout: box extent.
- 		
- 		"1.3) Adjust to layout bounds and do the layout."
- 		box := box origin - (self bounds origin - self layoutBounds origin) corner:
- 					box corner - (self bounds corner - self layoutBounds corner).
- 		self doLayoutIn: box].
- 	
- "	self assert: self layoutComputed.
- 	self assert: self owner layoutComputed not.
- "
- 	"2) Are we done already?"
- 	cellBounds extent = self bounds extent
- 		"Nice fit. I usually am done here if #minExtent did already trigger layout update (via #fullBounds) while my owner's layout was calculating the cell sizes."
- 		ifTrue:[^ self setPositionFromLayout: cellBounds origin].
- 		
- 	"3) We have the receiver's layout. Maybe we just computed it or we did not invalidate it in this run. The latter happens if our owner invalidates without telling us. The user dragging size grips in windows, for example. Now we have to consider #spaceFill constraints, which may trigger re-computation of the receiver's layout."
- 	box := self bounds.
- 	self hResizing == #spaceFill 
- 		ifTrue: [
- 			"Support dynamic width-for-height due to space-fill constraint -- another layout run needed?"
- 			(box width ~= cellBounds width and: [self vResizing == #shrinkWrap])
- 				ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]].
- 			"Fill the cell."
- 			box := box origin extent: cellBounds width @ box height].
- 		
- 	self vResizing == #spaceFill
- 		ifTrue: [
- 			"Support dynamic height-for-width due to space-fill constraint -- another layout run needed?"
- 			(box height ~= cellBounds height and: [self hResizing == #shrinkWrap])
- 				ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]].
- 			"Fill the cell."	
- 			box := box origin extent: box width @ cellBounds height].
- 
- 	"4) We have the receiver's layout. Align in the cell according o the owners layout properties."
- 	self flag: #refactor. "mt: #layoutInBounds: should also provide cellPositioning, not only cellBounds. There should be no need to access the owner in this method."
- 	aSymbol := self owner ifNil: [#center] ifNotNil: [:o | o cellPositioning].
- 	box := box align: (box perform: aSymbol) with: (cellBounds perform: aSymbol).
- 
- "	self assert: self layoutComputed.
- 	self assert: self owner layoutComputed not.
- "
- 	"5) Install the new bounds. This may invalidate my layout again, which is okay because my owner will ask about my fullBounds in #doLayoutIn: (and #privateFullBounds). My layout will be re-computed then."		
- 	self bounds: box.!

Item was added:
+ ----- Method: Morph>>layoutInBounds:positioning: (in category 'layout') -----
+ layoutInBounds: cellBounds positioning: cellPositioning
+ 	"Layout specific. Apply the given bounds to the receiver after being layed out in its owner."
+ 	
+ 	| box |	
+ 	"1) We are getting new bounds here but we haven't computed the receiver's layout yet."
+ 	self layoutComputed ifFalse:[
+ 		"Although the receiver has reported its #minExtent before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints (see #adjustLayoutBounds) then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds."
+ 		
+ 		"1.1) Adjust the box for #rigid receiver. Both #spaceFill and #shrinkWrap can use the cellBounds for now, which is important for many space-fills in a row or column to have the same widths (or heights) such as all MenuMorphItems in our MenuMorph."
+ 		box := cellBounds origin extent: 
+ 			(self hResizing == #rigid ifTrue: [self bounds extent x] ifFalse: [cellBounds extent x]) @
+ 			(self vResizing == #rigid ifTrue: [self bounds extent y] ifFalse: [cellBounds extent y]).
+ 		
+ 		"1.2) Move and resize the receiver to get started."
+ 		self
+ 			setPositionFromLayout: box origin;
+ 			setExtentFromLayout: box extent.
+ 		
+ 		"1.3) Adjust to layout bounds and do the layout."
+ 		box := box origin - (self bounds origin - self layoutBounds origin) corner:
+ 					box corner - (self bounds corner - self layoutBounds corner).
+ 		self doLayoutIn: box].
+ 	
+ "	self assert: self layoutComputed.
+ 	self assert: self owner layoutComputed not.
+ "
+ 	"2) Are we done already?"
+ 	cellBounds extent = self bounds extent
+ 		"Nice fit. I usually am done here if #minExtent did already trigger layout update (via #fullBounds) while my owner's layout was calculating the cell sizes."
+ 		ifTrue:[^ self setPositionFromLayout: cellBounds origin].
+ 		
+ 	"3) We have the receiver's layout. Maybe we just computed it or we did not invalidate it in this run. The latter happens if our owner invalidates without telling us. The user dragging size grips in windows, for example. Now we have to consider #spaceFill constraints, which may trigger re-computation of the receiver's layout."
+ 	box := self bounds.
+ 	self hResizing == #spaceFill 
+ 		ifTrue: [
+ 			"Support dynamic width-for-height due to space-fill constraint -- another layout run needed?"
+ 			(box width ~= cellBounds width and: [self vResizing == #shrinkWrap])
+ 				ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]].
+ 			"Fill the cell."
+ 			box := box origin extent: cellBounds width @ box height].
+ 		
+ 	self vResizing == #spaceFill
+ 		ifTrue: [
+ 			"Support dynamic height-for-width due to space-fill constraint -- another layout run needed?"
+ 			(box height ~= cellBounds height and: [self hResizing == #shrinkWrap])
+ 				ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]].
+ 			"Fill the cell."	
+ 			box := box origin extent: box width @ cellBounds height].
+ 
+ 	"4) We have the receiver's layout. Align in the cell according o the owners layout properties."
+ 	box := box align: (box perform: cellPositioning) with: (cellBounds perform: cellPositioning).
+ 
+ "	self assert: self layoutComputed.
+ 	self assert: self owner layoutComputed not.
+ "
+ 	"5) Install the new bounds. This may invalidate my layout again, which is okay because my owner will ask about my fullBounds in #doLayoutIn: (and #privateFullBounds). My layout will be re-computed then."		
+ 	self bounds: box.!

Item was changed:
  ----- Method: Morph>>layoutProportionallyIn: (in category 'layout') -----
  layoutProportionallyIn: newBounds
- 	"Layout specific. Apply the given bounds to the receiver."
- 	| box frame |
- 	frame := self layoutFrame ifNil:[^self].
- 	"compute the cell size the receiver has given its layout frame"
  	
+ 	self flag: #deprecated. "No actual deprecation warning because of debugging hazards."
+ 	self
+ 		layoutProportionallyInBounds: newBounds
+ 		positioning: (self owner ifNil: [#center] ifNotNil: [:o | o cellPositioning]).!
- 	box := frame layout: self bounds in: newBounds.
- 	box := box topLeft extent: (box extent max: self minExtent).
- 	
- 	(box = self bounds) ifTrue:[^self]. "no change"
- 	^self layoutInBounds: box.!

Item was added:
+ ----- Method: Morph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 	"Layout specific. Apply the given bounds to the receiver."
+ 	| cellBounds frame |
+ 	frame := self layoutFrame ifNil:[^self].
+ 	"compute the cell size the receiver has given its layout frame"
+ 	
+ 	cellBounds := frame layout: self bounds in: layoutBounds.
+ 	cellBounds := cellBounds topLeft extent: (cellBounds extent max: self minExtent).
+ 	
+ 	cellBounds = self bounds ifTrue: [^self]. "no change"
+ 	^self layoutInBounds: cellBounds positioning: cellPositioning!

Item was changed:
  ----- Method: Morph>>minExtent (in category 'layout') -----
  minExtent
  	"Layout specific. Return the minimum size the receiver can be represented in.
  	Implementation note: When this message is sent from an owner trying to lay out its children it will traverse down the morph tree and recompute the minimal arrangement of the morphs based on which the minimal extent is returned. When a morph with some layout strategy is encountered, the morph will ask its strategy to compute the new arrangement. However, since the final size given to the receiver is unknown at the point of the query, the assumption is made that the current bounds of the receiver are the base on which the layout should be computed. This scheme prevents strange layout changes when for instance, a table is contained in another table. Unless the inner table has been resized manually (which means its bounds are already enlarged) the arrangement of the inner table will not change here. Thus the entire layout computation is basically an iterative process which may have different results depending on the incremental changes applied."
  
  	| layout minExtent extra hFit vFit |
  	hFit := self hResizing.
  	vFit := self vResizing.
  	
  	(self owner isNil or: [self owner layoutPolicy isNil])
  		ifTrue: [
  			hFit == #spaceFill ifTrue: [hFit := #rigid].
  			vFit == #spaceFill ifTrue: [vFit := #rigid]].
  
  	"0) The receiver will not adjust to parents layout by growing or shrinking, which means that an accurate layout defines the minimum size. So, compute the layout and return its bounds as minimal extent. DO NOT return fullBounds because the morph itself is being layed out."
  	(hFit == #spaceFill or: [vFit == #spaceFill]) 
  		ifFalse: [self fullBounds. ^ self bounds extent].
  
  	"1) Ask the layout policy to compute the minimum extent."
  	layout := self layoutPolicy.
  	layout isNil 
  		ifTrue: [minExtent := 0 at 0]
  		ifFalse: [minExtent := layout minExtentOf: self in: self layoutBounds].
  
  	"2) #rigid fitting has to stay as is." 
  	hFit == #rigid 
  		ifTrue: [minExtent := self width @ minExtent y].
  	vFit == #rigid 
  		ifTrue: [minExtent := minExtent x @ self height].
  
  	"3) #spaceFill fitting has to account for layout inset."
  	hFit == #spaceFill
  		ifTrue: [
  			(vFit == #shrinkWrap and: [self wrapDirection ~= #none])
  				ifTrue: [minExtent := 1 @ minExtent y "Give h-space a chance to v-wrap and v-shrink."]
  				ifFalse: [
  					extra := self bounds width - self layoutBounds width.
  					minExtent := (minExtent x + extra) @ minExtent y]].
  	vFit == #spaceFill
  		ifTrue: [
  			(hFit == #shrinkWrap and: [self wrapDirection ~= #none])
  				ifTrue: [minExtent := minExtent x @ 1 "Give v-space a chance to h-wrap and h-shrink."]
  				ifFalse: [
  					extra := self bounds height - self layoutBounds height.
  					minExtent := minExtent x @ (minExtent y + extra)]].
  
  	"4) #shrinkWrap fitting has to support height-for-width (or width-for-height)."
+ 	hFit == #shrinkWrap
- 	(hFit == #shrinkWrap and: [layout notNil])
  		ifTrue: [
  			self fullBounds. "Compute layout now to get shrink-wrapped width."
  			minExtent := self width @ minExtent y].
+ 	vFit == #shrinkWrap
- 	(vFit == #shrinkWrap and: [layout notNil])
  		ifTrue: [
  			self fullBounds. "Compute layout now to get shrink-wrapped height."
  			minExtent := minExtent x @ self height].
  
+ 	"5) For morphs without submorphs (or without a layout policy), be sure to overwrite #doLayoutIn: and use #minWidth and #minHeight to implement #shrinkWrap such as in MenuItemMorph."
- 	"5) For morphs without submorphs, use #minWidth and #minHeight to implement #shrinkWrap such as in MenuItemMorph"
  	^ minExtent max: self minWidth @ self minHeight!

Item was removed:
- ----- Method: PluggableTextMorph>>extent: (in category 'geometry') -----
- extent: aPoint
- 
- 	super extent: aPoint.
- 	
- 	"Update vertical scroll bars because if text is wrapped."
- 	textMorph ifNotNil: [:tm |
- 		tm isAutoFit ifTrue: [self vSetScrollDelta]].!

Item was changed:
  ----- Method: PluggableTextMorph>>initialize (in category 'initialization') -----
  initialize
  
  	self initializeTextMorph.
  	super initialize.
  
  	hasUnacceptedEdits := false.
  	hasEditingConflicts := false.
  	askBeforeDiscardingEdits := true.
  
  	self minimumWidth: (TextStyle defaultFont widthOf: $m) * 10.
  		
+ 	scroller
+ 		layoutPolicy: TableLayout new;
+ 		addMorph: textMorph.
- 	scroller addMorph: textMorph.
  	
  	"Reset minExtent because only now we can anser #isAutoFit correctly."
  	self minimumExtent: 0 at 0; updateMinimumExtent.!

Item was changed:
  ----- Method: PluggableTextMorph>>initializeTextMorph (in category 'initialization') -----
  initializeTextMorph
  
  	textMorph := self textMorphClass new
  		margins: (3 at 0 corner: 0 at 0);
  		setEditView: self;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
- 		autoFit: true;
  		setProperty: #indicateKeyboardFocus toValue: #never;
  		yourself.!

Item was removed:
- ----- Method: PluggableTextMorph>>resizeScroller (in category 'geometry') -----
- resizeScroller
- 	"Also needs to resize the text morph"
- 
- 	super resizeScroller.
- 
- 	textMorph ifNotNil: [:tm |
- 		tm isWrapped ifTrue: [textMorph extent: self scroller extent]].!

Item was changed:
  ----- Method: PluggableTextMorph>>wrapFlag: (in category 'accessing') -----
  wrapFlag: aBoolean
  
  	textMorph ifNil: [self setText: ''].
- 	textMorph
- 		wrapFlag: aBoolean;
- 		autoFit: true.
  	
+ 	aBoolean
+ 		ifTrue: [
+ 			textMorph hResizing: #spaceFill.
+ 			self hideHScrollBarIndefinitely]
+ 		ifFalse: [
+ 			textMorph hResizing: #shrinkWrap.
+ 			self showHScrollBarOnlyWhenNeeded].
- 	"Text navigation will be tedious if there is no horizontal scroll bar w/o wrapping."
- 	aBoolean ifFalse: [self showHScrollBarOnlyWhenNeeded].
  
  	self layoutChanged.!

Item was changed:
  ----- Method: ProportionalLayout>>layout:in: (in category 'layout') -----
+ layout: aMorph in: layoutBounds
- layout: aMorph in: newBounds
  	"Compute the layout for the given morph based on the new bounds"
+ 
+ 	aMorph submorphsDo: [:m |
+ 		m
+ 			layoutProportionallyInBounds: layoutBounds
+ 			positioning: aMorph cellPositioning].!
- 	aMorph submorphsDo:[:m| m layoutProportionallyIn: newBounds].!

Item was removed:
- ----- Method: RightGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	super layoutProportionallyIn: cellBounds.
- 	
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self right: owner right.
- 	
- 	self top: owner top.
- 	self height: owner height.!

Item was added:
+ ----- Method: RightGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 
+ 	super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
+ 	
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self right: owner right.
+ 	
+ 	self top: owner top.
+ 	self height: owner height.!

Item was changed:
  ----- Method: ScrollPane>>doLayoutIn: (in category 'layout') -----
  doLayoutIn: layoutBounds
  	"Manually layout my submorphs. Maybe we can find a proper layout policy in the future."
- 	
- 	"1) Let submorph's #shrinkWrap first if they want to."
- 	self submorphsDo: [:m | m fullBounds].
  
+ 	| priorBounds |
+ 	priorBounds := bounds.
+ 	
- 	self removeProperty: #doLayoutAgain.
  	self updateLayout.
  	super doLayoutIn: layoutBounds.
  
  	"Do one additional run if required."
+ 	(priorBounds ~= bounds or: [self hasProperty: #doLayoutAgainHere]) ifTrue: [
- 	(self hasProperty: #doLayoutAgain) ifTrue: [
  		self updateLayout.
+ 		super doLayoutIn: layoutBounds.
+ 		"self assert: (self hasProperty: #doLayoutAgainHere) not. --- Not working yet."].!
- 		super doLayoutIn: layoutBounds].!

Item was changed:
+ ----- Method: ScrollPane>>hHideOrShowScrollBar (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>hHideOrShowScrollBar (in category 'scrolling') -----
  hHideOrShowScrollBar
  	"Hide or show the scrollbar depending on if the pane is scrolled/scrollable."
  
  	self hIsScrollbarNeeded
  		ifTrue:[ self hShowScrollBar ]
  		ifFalse: [ self hHideScrollBar ].
  !

Item was changed:
+ ----- Method: ScrollPane>>hHideScrollBar (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>hHideScrollBar (in category 'scrolling') -----
  hHideScrollBar
  
  	self hIsScrollbarShowing ifFalse: [^self].
+ 	self removeMorph: hScrollBar.
+ 	retractableScrollBar ifFalse: [self setProperty: #doLayoutAgainHere toValue: true].!
- 	self removeMorph: hScrollBar.!

Item was changed:
+ ----- Method: ScrollPane>>hIsScrollbarNeeded (in category 'geometry testing') -----
- ----- Method: ScrollPane>>hIsScrollbarNeeded (in category 'scrolling') -----
  hIsScrollbarNeeded
  "Return whether the horz scrollbar is needed"
  
  	"Don't do anything with the retractable scrollbar unless we have focus"
  	retractableScrollBar & self hasFocus not ifTrue: [^false].
  	
  	"Don't show it if we were told not to."
  	self hScrollBarPolicy == #never ifTrue: [^false].
  
  	"Always show it if we were told to"
  	self hScrollBarPolicy == #always ifTrue: [^true].
  
  	^self hIsScrollable
  !

Item was changed:
+ ----- Method: ScrollPane>>hResizeScrollBar (in category 'layout - resizing') -----
- ----- Method: ScrollPane>>hResizeScrollBar (in category 'geometry') -----
  hResizeScrollBar
  
  	| topLeft h border offset |
  	self hScrollBarPolicy == #never ifTrue: [^self].
- 	self bounds ifNil: [self fullBounds].
  	
  	h := self scrollBarThickness.
  	border := self borderWidth.
  	offset := (scrollBarOnLeft and: [self vIsScrollbarShowing and: [retractableScrollBar not]])
  		ifTrue: [h]
  		ifFalse: [0].
  	
  	topLeft := retractableScrollBar
  				ifTrue: [bounds bottomLeft + (offset @ border negated)]
  				ifFalse: [bounds bottomLeft + (offset @ h negated)].
  
  	hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ h)!

Item was changed:
+ ----- Method: ScrollPane>>hSetScrollDelta (in category 'layout - scrolling') -----
- ----- Method: ScrollPane>>hSetScrollDelta (in category 'geometry') -----
  hSetScrollDelta
  	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
  
  	| delta |	
  	delta := self scrollDeltaWidth.
  
  	hScrollBar
  			truncate: true;
  			scrollDelta: delta 
  			pageDelta: 10*delta;
  			maximumValue: self hLeftoverScrollRange;
  			interval: (self hTotalScrollRange = 0
  				ifTrue: [1.0]
  				ifFalse: [scroller width / self hTotalScrollRange]);
  			setValue: scroller offset x.!

Item was changed:
+ ----- Method: ScrollPane>>hShowScrollBar (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>hShowScrollBar (in category 'scrolling') -----
  hShowScrollBar
  
  	self hIsScrollbarShowing ifTrue: [^self].
  	self hResizeScrollBar.
  	self privateAddMorph: hScrollBar atIndex: 1.
+ 	retractableScrollBar
+ 		ifTrue: [self comeToFront]
+ 		ifFalse: [self setProperty: #doLayoutAgainHere toValue: true].!
- 	retractableScrollBar ifTrue: [self comeToFront].!

Item was changed:
+ ----- Method: ScrollPane>>hideOrShowScrollBars (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>hideOrShowScrollBars (in category 'scrolling') -----
  hideOrShowScrollBars
+ 
+ 	self scroller hasSubmorphs ifTrue: [
+ 		self flag: #performance. "mt: Can we know somehow in advance?"
+ 		self scroller firstSubmorph changesHeightForWidth
+ 			ifTrue: [self vHideScrollBar; resizeScroller; vHideOrShowScrollBar; resizeScroller].
+ 		self scroller firstSubmorph changesWidthForHeight
+ 			ifTrue: [self hHideScrollBar; resizeScroller; hHideOrShowScrollBar; resizeScroller]].
+ 
+ 	self removeProperty: #doLayoutAgainHere. "Detect change."
  	
  	"There is the one edge case where no scroll bar would be needed if both scroll bars would just disappear."
  	(((((self vScrollBarPolicy = #whenNeeded and: [self hScrollBarPolicy = #whenNeeded])
  		and: [self retractableScrollBar not])
  		and: [self vIsScrollbarShowing and: [self hIsScrollbarShowing]])
  		and: [self hLeftoverScrollRange <= self vScrollBar width])
  		and: [self vLeftoverScrollRange <= self hScrollBar height])
  			ifTrue: [^ self vHideScrollBar; hHideScrollBar].
  
  	self 
  		vHideOrShowScrollBar; 
  		hHideOrShowScrollBar.!

Item was changed:
+ ----- Method: ScrollPane>>hideScrollBars (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>hideScrollBars (in category 'scrolling') -----
  hideScrollBars
  	self
  		vHideScrollBar;
  		hHideScrollBar
  !

Item was removed:
- ----- Method: ScrollPane>>layoutChanged (in category 'layout') -----
- layoutChanged
- 
- 	self setProperty: #doLayoutAgain toValue: true.
- 	super layoutChanged.!

Item was changed:
+ ----- Method: ScrollPane>>resizeScrollBars (in category 'layout - resizing') -----
- ----- Method: ScrollPane>>resizeScrollBars (in category 'geometry') -----
  resizeScrollBars
  	self vResizeScrollBar; hResizeScrollBar
  !

Item was changed:
+ ----- Method: ScrollPane>>resizeScroller (in category 'layout - resizing') -----
- ----- Method: ScrollPane>>resizeScroller (in category 'geometry') -----
  resizeScroller
  
+ 	scroller
+ 		bounds: self layoutBounds;
+ 		fullBounds. "To make #shrinkWrap work."!
- 	scroller bounds: self innerBounds!

Item was changed:
  ----- Method: ScrollPane>>scroller: (in category 'accessing') -----
  scroller: aTransformMorph
  	scroller ifNotNil:[scroller delete].
  	scroller := aTransformMorph.
+ 	self addMorph: scroller.!
- 	self addMorph: scroller.
- 	self resizeScroller.!

Item was changed:
+ ----- Method: ScrollPane>>setScrollDeltas (in category 'layout - scrolling') -----
- ----- Method: ScrollPane>>setScrollDeltas (in category 'geometry') -----
  setScrollDeltas
  	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
  
  	scroller ifNil: [^ self].
  	
  	self hideOrShowScrollBars.
  	self vSetScrollDelta.
  	self hSetScrollDelta.!

Item was changed:
+ ----- Method: ScrollPane>>showScrollBars (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>showScrollBars (in category 'scrolling') -----
  showScrollBars
  	self  vShowScrollBar; hShowScrollBar
  !

Item was changed:
  ----- Method: ScrollPane>>updateLayout (in category 'layout') -----
  updateLayout
  	"Manually layout my submorphs. Maybe we can find a proper layout policy in the future."
  	
  	"If the scroller happens to have a layout policy, we should compute its layout before updating the scroll bars"
  	self resizeScroller.
+ 	
- 	self scroller fullBounds.
- 
  	self
  		resizeScrollBars;
  		adjustOffset;
  		setScrollDeltas.
  
  
  !

Item was changed:
+ ----- Method: ScrollPane>>vHideOrShowScrollBar (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>vHideOrShowScrollBar (in category 'scrolling') -----
  vHideOrShowScrollBar
  
  	self vIsScrollbarNeeded
  		ifTrue:[ self vShowScrollBar ]
  		ifFalse:[ self vHideScrollBar ].
  !

Item was changed:
+ ----- Method: ScrollPane>>vHideScrollBar (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>vHideScrollBar (in category 'scrolling') -----
  vHideScrollBar
+ 
  	self vIsScrollbarShowing ifFalse: [^self].
+ 	self removeMorph: scrollBar.
+ 	retractableScrollBar ifFalse: [self setProperty: #doLayoutAgainHere toValue: true].!
- 	self removeMorph: scrollBar.!

Item was changed:
+ ----- Method: ScrollPane>>vIsScrollbarNeeded (in category 'geometry testing') -----
- ----- Method: ScrollPane>>vIsScrollbarNeeded (in category 'scrolling') -----
  vIsScrollbarNeeded
  "Return whether the verticle scrollbar is needed"
  
  	"Don't do anything with the retractable scrollbar unless we have focus"
  	retractableScrollBar & self hasFocus not ifTrue: [^false].
  	
  	"Don't show it if we were told not to."
  	self vScrollBarPolicy == #never ifTrue: [^false].
  
  	"Always show it if we were told to"
  	self vScrollBarPolicy == #always ifTrue: [^true].
  	
  	^self vIsScrollable
  !

Item was changed:
+ ----- Method: ScrollPane>>vResizeScrollBar (in category 'layout - resizing') -----
- ----- Method: ScrollPane>>vResizeScrollBar (in category 'geometry') -----
  vResizeScrollBar
+ 
  	| w topLeft border |
+ 	self vScrollBarPolicy == #never ifTrue: [^self].
+ 	
  	w := self scrollBarThickness.
  	border := self borderWidth.
  	topLeft := scrollBarOnLeft 
  		ifTrue: [retractableScrollBar 
  			ifTrue: [bounds topLeft - ((w - border) @ 0)]
  			ifFalse: [bounds topLeft]]
  		ifFalse: [retractableScrollBar 
  			ifTrue: [bounds topRight - (border @ 0)]
  			ifFalse: [bounds topRight - (w @ 0)]].
  			
  	scrollBar bounds: (topLeft extent: w @ self vScrollBarHeight)
  	
  !

Item was changed:
+ ----- Method: ScrollPane>>vSetScrollDelta (in category 'layout - scrolling') -----
- ----- Method: ScrollPane>>vSetScrollDelta (in category 'geometry') -----
  vSetScrollDelta
  	"Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
  
  	| delta |	
  	delta := self scrollDeltaHeight.
  
  	scrollBar
  			truncate: true;
  			scrollDelta: delta 
  			pageDelta: 10*delta;
  			maximumValue: self vLeftoverScrollRange;
  			interval: (self vTotalScrollRange = 0
  				ifTrue: [1.0]
  				ifFalse: [scroller height / self vTotalScrollRange]);
  			setValue: scroller offset y.!

Item was changed:
+ ----- Method: ScrollPane>>vShowScrollBar (in category 'layout - visibility') -----
- ----- Method: ScrollPane>>vShowScrollBar (in category 'scrolling') -----
  vShowScrollBar
  
  	self vIsScrollbarShowing ifTrue: [^ self].
  	self vResizeScrollBar.
  	self privateAddMorph: scrollBar atIndex: 1.
+ 	retractableScrollBar
+ 		ifTrue: [self comeToFront]
+ 		ifFalse:[self setProperty: #doLayoutAgainHere toValue: true].!
- 	retractableScrollBar ifTrue: [self comeToFront]!

Item was changed:
  ----- Method: TableLayout>>layoutLeftToRight:in: (in category 'optimized') -----
  layoutLeftToRight: aMorph in: newBounds 
  	"An optimized left-to-right list layout"
  
  	| inset insetExtra gap extent block posX posY centering extraPerCell amount minX minY maxX maxY n width extra last cell size height sum vFill first cellRect |
  	size := properties minCellSize asPoint.
  	minX := size x.
  	minY := size y.
  	size := properties maxCellSize asPoint.
  	maxX := size x.
  	maxY := size y.
  	inset := properties cellInset.
  	insetExtra := inset isRectangle
  		ifTrue: [insetExtra := inset left + inset right @ (inset top + inset bottom)]
  		ifFalse: [insetExtra := inset*2 asPoint].
  	(inset isNumber and: [inset isZero]) ifTrue: [inset := nil].
  	gap := properties cellGap asPoint x.
  	extent := newBounds extent.
  	n := 0.
  	vFill := false.
  	sum := 0.
  	width := height := 0.
  	first := last := nil.
  	block := 
  			[:m | | sizeX props sizeY | 
  			props := m layoutProperties ifNil: [m].
  			props disableTableLayout 
  				ifFalse: 
  					[n := n + 1.
  					cell := LayoutCell new target: m.
  					props hResizing == #spaceFill 
  						ifTrue: 
  							[cell hSpaceFill: true.
  							extra := m spaceFillWeight.
  							cell extraSpace: extra.
  							sum := sum + extra]
  						ifFalse: [cell hSpaceFill: false].
  					props vResizing == #spaceFill ifTrue: [vFill := true].
  					size := m minExtent + insetExtra.
  					sizeX := size x.
  					sizeY := size y.
  					sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX].
  					sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY].
  					cell cellSize: sizeX.
  					last ifNil: [first := cell] ifNotNil: [last nextCell: cell].
  					last := cell.
  					width := width + sizeX.
  					sizeY > height ifTrue: [height := sizeY]]].
  	properties reverseTableCells 
  		ifTrue: [aMorph submorphsReverseDo: block]
  		ifFalse: [aMorph submorphsDo: block].
  	n > 1 ifTrue: [width := width + ((n - 1) * gap)].
  	(properties hResizing == #shrinkWrap 
  		and: [properties rubberBandCells or: [sum isZero]]) 
  			ifTrue: [extent := width @ (extent y max: height)].
  	(properties vResizing == #shrinkWrap 
  		and: [properties rubberBandCells or: [vFill not]]) 
  			ifTrue: [extent := (extent x max: width) @ height].
  	posX := newBounds left.
  	posY := newBounds top.
  
  	"Compute extra vertical space"
  	extra := extent y - height.
  	extra := extra max: 0.
  	extra > 0 
  		ifTrue: 
  			[vFill 
  				ifTrue: [height := extent y]
  				ifFalse: 
  					[centering := properties wrapCentering.
  					centering == #bottomRight ifTrue: [posY := posY + extra].
  					centering == #center ifTrue: [posY := posY + (extra // 2)]]].
  
  
  	"Compute extra horizontal space"
  	extra := extent x - width.
  	extra := extra max: 0.
  	extraPerCell := 0.
  	extra > 0 
  		ifTrue: 
  			[sum isZero 
  				ifTrue: 
  					["extra space but no #spaceFillers"
  
  					centering := properties listCentering.
  					centering == #bottomRight ifTrue: [posX := posX + extra].
  					centering == #center ifTrue: [posX := posX + (extra // 2)]]
  				ifFalse: [extraPerCell := extra asFloat / sum asFloat]].
  	n := 0.
  	extra := last := 0.
  	cell := first.
  	[cell isNil] whileFalse: 
  			[n := n + 1.
  			width := cell cellSize.
  			(extraPerCell > 0 and: [cell hSpaceFill]) 
  				ifTrue: 
  					[extra := (last := extra) + (extraPerCell * cell extraSpace).
  					amount := extra truncated - last truncated.
  					width := width + amount].
  			cellRect := (posX @ posY extent: width @ height).
  			inset ifNotNil: [cellRect := cellRect insetBy: inset].
+ 			cell target
+ 				layoutInBounds: cellRect
+ 				positioning: properties cellPositioning.
- 			cell target layoutInBounds: cellRect.
  			posX := posX + width + gap.
  			cell := cell nextCell]!

Item was changed:
  ----- Method: TableLayout>>layoutTopToBottom:in: (in category 'optimized') -----
  layoutTopToBottom: aMorph in: newBounds 
  	"An optimized top-to-bottom list layout"
  
  	| inset insetExtra gap extent block posX posY centering extraPerCell amount minX minY maxX maxY n height extra last cell size width sum vFill first cellRect |
  	size := properties minCellSize asPoint.
  	minX := size x.
  	minY := size y.
  	size := properties maxCellSize asPoint.
  	maxX := size x.
  	maxY := size y.
  	inset := properties cellInset.
  	insetExtra := inset isRectangle
  		ifTrue: [insetExtra := inset left + inset right @ (inset top + inset bottom)]
  		ifFalse: [insetExtra := inset*2 asPoint].
  	(inset isNumber and: [inset isZero]) ifTrue: [inset := nil].
  	gap := properties cellGap asPoint y.
  	extent := newBounds extent.
  	n := 0.
  	vFill := false.
  	sum := 0.
  	width := height := 0.
  	first := last := nil.
  	block := 
  			[:m | | sizeY sizeX props | 
  			props := m layoutProperties ifNil: [m].
  			props disableTableLayout 
  				ifFalse: 
  					[n := n + 1.
  					cell := LayoutCell new target: m.
  					props vResizing == #spaceFill 
  						ifTrue: 
  							[cell vSpaceFill: true.
  							extra := m spaceFillWeight.
  							cell extraSpace: extra.
  							sum := sum + extra]
  						ifFalse: [cell vSpaceFill: false].
  					props hResizing == #spaceFill ifTrue: [vFill := true].
  					size := m minExtent + insetExtra.
  					sizeX := size x.
  					sizeY := size y.
  					sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX].
  					sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY].
  					cell cellSize: sizeY.
  					first ifNil: [first := cell] ifNotNil: [last nextCell: cell].
  					last := cell.
  					height := height + sizeY.
  					sizeX > width ifTrue: [width := sizeX]]].
  	properties reverseTableCells 
  		ifTrue: [aMorph submorphsReverseDo: block]
  		ifFalse: [aMorph submorphsDo: block].
  	n > 1 ifTrue: [height := height + ((n - 1) * gap)].
  	(properties vResizing == #shrinkWrap 
  		and: [properties rubberBandCells or: [sum isZero]]) 
  			ifTrue: [extent := (extent x max: width) @ height].
  	(properties hResizing == #shrinkWrap 
  		and: [properties rubberBandCells or: [vFill not]]) 
  			ifTrue: [extent := width @ (extent y max: height)].
  	posX := newBounds left.
  	posY := newBounds top.
  
  	"Compute extra horizontal space"
  	extra := extent x - width.
  	extra := extra max: 0.
  	extra > 0 
  		ifTrue: 
  			[vFill 
  				ifTrue: [width := extent x]
  				ifFalse: 
  					[centering := properties wrapCentering.
  					centering == #bottomRight ifTrue: [posX := posX + extra].
  					centering == #center ifTrue: [posX := posX + (extra // 2)]]].
  
  
  	"Compute extra vertical space"
  	extra := extent y - height.
  	extra := extra max: 0.
  	extraPerCell := 0.
  	extra > 0 
  		ifTrue: 
  			[sum isZero 
  				ifTrue: 
  					["extra space but no #spaceFillers"
  
  					centering := properties listCentering.
  					centering == #bottomRight ifTrue: [posY := posY + extra].
  					centering == #center ifTrue: [posY := posY + (extra // 2)]]
  				ifFalse: [extraPerCell := extra asFloat / sum asFloat]].
  	n := 0.
  	extra := last := 0.
  	cell := first.
  	[cell isNil] whileFalse: 
  			[n := n + 1.
  			height := cell cellSize.
  			(extraPerCell > 0 and: [cell vSpaceFill]) 
  				ifTrue: 
  					[extra := (last := extra) + (extraPerCell * cell extraSpace).
  					amount := extra truncated - last truncated.
  					height := height + amount].
  			cellRect := (posX @ posY extent: width @ height).
  			inset ifNotNil: [cellRect := cellRect insetBy: inset].
+ 			cell target
+ 				layoutInBounds: cellRect
+ 				positioning: properties cellPositioning.
- 			cell target layoutInBounds: cellRect.
  			posY := posY + height + gap.
  			cell := cell nextCell]!

Item was changed:
  ----- Method: TableLayout>>placeCells:in:horizontal:target: (in category 'layout') -----
  placeCells: arrangement in: newBounds horizontal: aBool target: aMorph 
  	"Place the morphs within the cells accordingly"
  
  	| xDir yDir anchor yDist place cell xDist cellRect corner inset |
  	inset := properties cellInset.
  	(inset isNumber and: [inset isZero]) ifTrue: [inset := nil].
  	aBool 
  		ifTrue: 
  			["horizontal layout"
  
  			properties listDirection == #rightToLeft 
  				ifTrue: 
  					[xDir := -1 @ 0.
  					properties wrapDirection == #bottomToTop 
  						ifTrue: 
  							[yDir := 0 @ -1.
  							anchor := newBounds bottomRight]
  						ifFalse: 
  							[yDir := 0 @ 1.
  							anchor := newBounds topRight]]
  				ifFalse: 
  					[xDir := 1 @ 0.
  					properties wrapDirection == #bottomToTop 
  						ifTrue: 
  							[yDir := 0 @ -1.
  							anchor := newBounds bottomLeft]
  						ifFalse: 
  							[yDir := 0 @ 1.
  							anchor := newBounds topLeft]]]
  		ifFalse: 
  			["vertical layout"
  
  			properties listDirection == #bottomToTop 
  				ifTrue: 
  					[xDir := 0 @ -1.
  					properties wrapDirection == #rightToLeft 
  						ifTrue: 
  							[yDir := -1 @ 0.
  							anchor := newBounds bottomRight]
  						ifFalse: 
  							[yDir := 1 @ 0.
  							anchor := newBounds bottomLeft]]
  				ifFalse: 
  					[xDir := 0 @ 1.
  					anchor := properties wrapDirection == #rightToLeft 
  								ifTrue: 
  									[yDir := -1 @ 0.
  									newBounds topRight]
  								ifFalse: 
  									[yDir := 1 @ 0.
  									newBounds topLeft]]].
  	1 to: arrangement size
  		do: 
  			[:i | 
  			cell := arrangement at: i.
  			cell extraSpace ifNotNil: [anchor := anchor + (cell extraSpace y * yDir)].
  			yDist := cell cellSize y * yDir.	"secondary advance direction"
  			place := anchor.
  			cell := cell nextCell.
  			[cell isNil] whileFalse: 
  					[cell extraSpace ifNotNil: [place := place + (cell extraSpace x * xDir)].
  					xDist := cell cellSize x * xDir.	"primary advance direction"
  					corner := place + xDist + yDist.
  					cellRect := Rectangle origin: (place min: corner)
  								corner: (place max: corner).
  					inset ifNotNil: [cellRect := cellRect insetBy: inset].
+ 					cell target
+ 						layoutInBounds: cellRect
+ 						positioning: properties cellPositioning.
- 					cell target layoutInBounds: cellRect.
  					place := place + xDist.
  					cell := cell nextCell].
  			anchor := anchor + yDist]!

Item was changed:
  ----- Method: TextMorph>>autoFit: (in category 'accessing') -----
  autoFit: trueOrFalse
+ 	"Private!! Please use #hResizing: and #vResizing:."
+ 	
  	"Whether I automatically adjust my size to fit text as it changes"
  	
  	self isAutoFit = trueOrFalse ifTrue: [^ self].
  	self autoFitOnOff.!

Item was changed:
  ----- Method: TextMorph>>minHeight (in category 'layout') -----
  minHeight
  
  	| result |
- 	"Layout specific. If either height or width are shrink-wrapping, we have to leave the other dimension as is. Otherwise, those results would be incorrect. Note that you can still set #extent: so smaller values to recompute the paragraph."
- 	self vResizing == #shrinkWrap
- 		ifTrue: [self fullBounds. ^ self height].
- 	
  	textStyle ifNil: [^ 16].
  
  	result := (textStyle lineGrid + 2) + (self borderWidth*2).
  	margins ifNil: [^ result].
  	
  	^ margins isRectangle
  		ifTrue: [result + margins top + margins bottom]
  		ifFalse: [margins isPoint
  			ifTrue: [result + margins y + margins y]
  			ifFalse: [result + (2*margins)]]!

Item was changed:
  ----- Method: TextMorph>>minWidth (in category 'layout') -----
  minWidth
  
  	| result |
- 	"Layout specific. If either height or width are shrink-wrapping, we have to leave the other dimension as is. Otherwise, those results would be incorrect. Note that you can still set #extent: so smaller values to recompute the paragraph."
- 	self hResizing == #shrinkWrap
- 		ifTrue: [self fullBounds. ^ self width].
- 
  	textStyle ifNil: [^ 9].
  
  	result := 9 + (self borderWidth*2).
  	margins ifNil: [^ result].
  	
  	^ margins isRectangle
  		ifTrue: [result + margins left + margins right]
  		ifFalse: [margins isPoint
  			ifTrue: [result + margins x + margins x]
  			ifFalse: [result + (2*margins)]]!

Item was changed:
  ----- Method: TextMorph>>wrapFlag: (in category 'accessing') -----
  wrapFlag: aBoolean
+ 	"Private!! Please use #hResizing: and #vResizing:."
+ 
  	"Whether contained text will adjust its bounds as I change shape:
  		|	wrapFlag 	|		TextMorph grows			|		TextMorph shrinks 	|
  		|		true 		| wrapped lines fill new space	|	long lines wrap to fit 		|
  		|		false 		|   wrapped lines stay same 		|	long lines are cut off 		|"
  
  	aBoolean == wrapFlag ifTrue: [^ self].
  	wrapFlag := aBoolean.
  	self composeToBounds!

Item was removed:
- ----- Method: TopGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	super layoutProportionallyIn: cellBounds.
- 	
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self top: owner top.!

Item was added:
+ ----- Method: TopGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 
+ 	super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
+ 	
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self top: owner top.!

Item was removed:
- ----- Method: TopLeftGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 	
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self topLeft: owner topLeft.!

Item was added:
+ ----- Method: TopLeftGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 	
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self topLeft: owner topLeft.!

Item was removed:
- ----- Method: TopRightGripMorph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: cellBounds
- 
- 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- 	self topRight: owner topRight.!

Item was added:
+ ----- Method: TopRightGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
+ layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
+ 
+ 	self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
+ 	self topRight: owner topRight.!

Item was changed:
+ (PackageInfo named: 'Morphic') postscript: '"Reset all existing text fields because their scrollers have now an actual TableLayout."
+ PluggableTextMorph allSubInstancesDo: [:ea |
+ 	ea scroller layoutPolicy: TableLayout new.
+ 	ea textMorph vResizing: #shrinkWrap.
+ 	ea wrapFlag
+ 		ifTrue: [ea wrapFlag: true]
+ 		ifFalse: [ea wrapFlag: false; hideScrollBarsIndefinitely]].'!
- (PackageInfo named: 'Morphic') postscript: 'SystemNavigation cleanUp: true.
- Editor withAllSubclasses do: #initialize.
- 
- "Update emphasis cache in all existing string morphs."
- StringMorph allSubInstancesDo: [:m |
- 	m emphasis ifNil: [
- 		m emphasis: (m font ifNil: [0] ifNotNil: [:f | f emphasis])]].'!




More information about the Packages mailing list