Improved element size rendering

packages/HTML.package/CSSBackgroundFormatter.class/instance/readBackgroundAttribute.of.to..st

@@ -16,11 +16,13 @@ readBackgroundAttribute: propertyValue of: aCSSProperty to: aContext
 		(self isValidRepeatValue: each) 
 			ifTrue: [ self readBackgroundRepeatAttribute: each to: shorthandContext ]
 			ifFalse: [
-		((positionValues size < 2) and: [ each asInteger notNil ])
+		((positionValues size < 2) and: [ each asInteger notNil ] and: [ each first ~= $#])
 			ifTrue: [ positionValues add: each ]
 			ifFalse: [
 		(index = 1) 
 			ifTrue: [self readBackgroundColorAttribute: each to: shorthandContext ]]]]].
-	positionValues size = 2 ifTrue: [ self readBackgroundPositionAttribute: positionValues first, ' ', positionValues second to: shorthandContext ].
+	positionValues size = 2 ifTrue: [ 
+		self readBackgroundPositionAttribute: positionValues first, ' ', 
+			positionValues second to: shorthandContext ].
 
 	aContext addAll: shorthandContext

packages/HTML.package/CSSBackgroundFormatter.class/instance/readBackgroundPositionAttribute.to..st

@@ -3,8 +3,8 @@ readBackgroundPositionAttribute: propertyValue to: aContext
 	| values position |
 	values := propertyValue splitOn: ' '.
 	position := 0@0.
-	values first asNumber ifNotNil: [:xPos | position := position + ( xPos @ 0)].
-	values size > 1 ifTrue: [ 
-		values second asNumber ifNotNil: [:yPos | position := position + ( 0 @ yPos )]].
+	(self isNumber: values first) ifTrue: [position := position + ( values first asNumber @ 0)].
+	values size > 1 ifTrue: [
+		(self isNumber: values second) ifTrue: [position := position + ( 0 @ values second asNumber )]].
 
 	aContext at: #backgroundPosition put: position

packages/HTML.package/CSSBackgroundFormatter.class/methodProperties.json

@@ -4,8 +4,8 @@
 	"instance" : {
 		"isValidRepeatValue:" : "rs 6/20/2014 18:44:10.982",
 		"parseTextAttributesFrom:into:" : "rs 6/20/2014 20:52:07.231",
-		"readBackgroundAttribute:of:to:" : "rs 6/21/2014 10:28:51.341",
+		"readBackgroundAttribute:of:to:" : "rs 7/5/2014 10:16:48.535",
 		"readBackgroundColorAttribute:to:" : "rs 6/20/2014 18:33:38.685",
 		"readBackgroundImageAttribute:of:to:" : "rs 6/21/2014 11:55:16.861",
-		"readBackgroundPositionAttribute:to:" : "rs 6/20/2014 22:01:33.857",
+		"readBackgroundPositionAttribute:to:" : "rs 7/5/2014 10:31:31.526",
 		"readBackgroundRepeatAttribute:to:" : "rs 6/20/2014 18:48:01.003" } }

packages/HTML.package/CSSFormatter.class/instance/isNumber..st

@@ -0,0 +1,10 @@
+size-conversion
+isNumber: aString
+
+	(aString size > 0 and: [aString first isDigit])
+		ifTrue: [ ^ true ].
+
+	(aString size > 1 and: [aString first = $-] and: [aString second isDigit])
+		ifTrue: [ ^ true ].
+
+	^ false

packages/HTML.package/CSSFormatter.class/methodProperties.json

@@ -7,6 +7,7 @@
 		"inToPx:" : "SN 6/21/2014 11:38",
 		"isAbsoluteSize:" : "SN 6/25/2014 00:06",
 		"isAbsoluteSize:ifTrue:" : "SN 6/21/2014 12:16",
+		"isNumber:" : "rs 7/5/2014 10:28:11.467",
 		"isRelativeSize:" : "SN 6/28/2014 10:29",
 		"isRelativeSize:ifTrue:" : "SN 6/21/2014 12:16",
 		"mmToIn:" : "SN 6/21/2014 11:31",

packages/HTML.package/CSSSizeFormatter.class/instance/parseTextAttributesFrom.into..st

@@ -1,7 +1,21 @@
 parsing
 parseTextAttributesFrom: aCSSProperty into: aContext
 
-	aCSSProperty propertyName = 'height'
+	(aCSSProperty propertyName = 'height' and: [ self isNumber: aCSSProperty propertyString ])
 		ifTrue: [ aContext at: #height put: aCSSProperty propertyString asInteger ].
 	aCSSProperty propertyName = 'width'
-		ifTrue: [ aContext at: #width put: aCSSProperty propertyString asInteger ]
+		ifTrue: [
+			aContext at: #absoluteWidth put: nil.
+			aContext at: #relativeWidth put: nil.
+
+			aCSSProperty propertyString = 'auto' ifTrue: [
+				aContext at: #absoluteWidth put: #auto.
+				^ self].
+
+			self isRelativeSize: aCSSProperty propertyString ifTrue: [
+				"hope it's percent"
+				aContext at: #relativeWidth put: aCSSProperty propertyString asInteger.
+				^ self].
+			self isAbsoluteSize: aCSSProperty propertyString 
+				ifTrue: [ aContext at: #absoluteWidth put: 
+					(self absoluteSizeToPx: aCSSProperty propertyString defaultSize: 0) ] ]

packages/HTML.package/CSSSizeFormatter.class/methodProperties.json

@@ -2,4 +2,4 @@
 	"class" : {
 		 },
 	"instance" : {
-		"parseTextAttributesFrom:into:" : "rs 6/20/2014 20:16:31.89" } }
+		"parseTextAttributesFrom:into:" : "rs 7/5/2014 10:29:07.349" } }

packages/HTML.package/Color.extension/class/fromHexRGBString..st

@@ -5,12 +5,22 @@ fromHexRGBString: aString
 	aString first = $#
 		ifTrue: [ aColorHex := aString allButFirst ]
 		ifFalse: [ aColorHex := aString ].
-	(aColorHex size = 3 and: [ 
-		aColorHex allSatisfy: [ :each | '0123456789ABCDEFabcdef' includes: each ] ])
+		(aColorHex allSatisfy: [ :each | '0123456789ABCDEFabcdef' includes: each ])
+			ifFalse: [ ^ nil ].
+
+		(aColorHex size = 3)
 			ifTrue: [
 				| green red blue |
 				red := (Integer readFrom: (aColorHex first: 1) base: 16) / 15.
 				green := (Integer readFrom: (aColorHex copyFrom: 2 to: 2) base: 16) / 15.
 				blue := (Integer readFrom: (aColorHex last: 1) base: 16) / 15.
 				^self r: red g: green b: blue ].
+		(aColorHex size = 6)
+			ifTrue: [
+				| green red blue |
+				red := (Integer readFrom: (aColorHex first: 2) base: 16) / 255.
+				green := (Integer readFrom: (aColorHex copyFrom: 3 to: 4) base: 16) / 255.
+				blue := (Integer readFrom: (aColorHex last: 2) base: 16) / 255.
+				^self r: red g: green b: blue ].
+
 	^nil

packages/HTML.package/Color.extension/methodProperties.json

@@ -2,7 +2,7 @@
 	"class" : {
 		"fromColorName:" : "pf 5/25/2014 13:53",
 		"fromHTMLString:" : "js 5/25/2014 15:25",
-		"fromHexRGBString:" : "pf 5/25/2014 12:35",
+		"fromHexRGBString:" : "rs 7/3/2014 16:05:08.409",
 		"fromRGBFunction:" : "js 5/25/2014 15:35",
 		"fromRGBPercentageFunction:" : "js 5/25/2014 15:32",
 		"htmlColors1" : "SS 5/29/2014 16:39",

packages/HTML.package/ColorConversionTest.class/instance/test02ConvertHexRGBToColor.st

@@ -4,4 +4,5 @@ test02ConvertHexRGBToColor
 	self assert: (Color fromHTMLString: '#fff') equals: (Color r: 1 g: 1 b: 1).
 	self assert: (Color fromHTMLString: '#FFF') equals: (Color r: 1 g: 1 b: 1).
 	self assert: (Color fromHTMLString: '#000') equals: (Color r: 0 g: 0 b: 0).
-	self assert: (Color fromHTMLString: '#f08') equals: (Color r: 1 g: 0 b: 0.534).
+	self assert: (Color fromHTMLString: '#f08') equals: (Color r: 1 g: 0 b: 0.534).
+	self assert: (Color fromHTMLString: '#abcdef') equals: (Color r: 171/255 g: 205/255 b:239/255)

packages/HTML.package/ColorConversionTest.class/methodProperties.json

@@ -3,7 +3,7 @@
 		 },
 	"instance" : {
 		"test01ConvertNameToColor" : "SS 5/29/2014 16:41",
-		"test02ConvertHexRGBToColor" : "pf 5/25/2014 12:39",
+		"test02ConvertHexRGBToColor" : "rs 7/4/2014 22:01:57.437",
 		"test03ConvertHexRRGGBBToColor" : "pf 5/25/2014 12:41",
 		"test04ConvertRGBDecimalFunctionToColor" : "pf 5/25/2014 14:48",
 		"test05ConvertRGBPercentFunctionToColor" : "pf 5/25/2014 14:50",

packages/HTML.package/HtmlBODYNode.class/instance/defaultBlockMorph.st

@@ -0,0 +1,3 @@
+initialize-release
+defaultBlockMorph
+	^ HtmlBodyMorph

packages/HTML.package/HtmlBODYNode.class/methodProperties.json

@@ -2,4 +2,5 @@
 	"class" : {
 		 },
 	"instance" : {
+		"defaultBlockMorph" : "rs 6/28/2014 14:10:32.202",
 		"tag" : "" } }

packages/HTML.package/HtmlDOMNode.class/instance/getHtmlBlockMorph.st

@@ -1,13 +1,6 @@
 rendering
 getHtmlBlockMorph
-	| inlineNodes |
-
-	inlineNodes := OrderedCollection new.
-	htmlMorph := self defaultBlockMorph newFor: self.
 
-	self children do: [ :child | child isRenderedInline
-			ifTrue: [ inlineNodes add: child ]
-			ifFalse: [ self flushInlineNodes: inlineNodes to: htmlMorph;
-						flushBlockNode: child to: htmlMorph] ].
-	self flushInlineNodes: inlineNodes to: htmlMorph.
+	htmlMorph := self defaultBlockMorph newFor: self.
+	self renderChildrenInto: htmlMorph.
 	^ htmlMorph

packages/HTML.package/HtmlDOMNode.class/instance/renderChildrenInto..st

@@ -0,0 +1,10 @@
+rendering
+renderChildrenInto: aHtmlBlockMorph
+	| inlineNodes |
+
+	inlineNodes := OrderedCollection new.
+	self children do: [ :child | child isRenderedInline
+			ifTrue: [ inlineNodes add: child ]
+			ifFalse: [ self flushInlineNodes: inlineNodes to: aHtmlBlockMorph;
+						flushBlockNode: child to: aHtmlBlockMorph] ].
+	self flushInlineNodes: inlineNodes to: aHtmlBlockMorph

packages/HTML.package/HtmlDOMNode.class/methodProperties.json

@@ -30,7 +30,7 @@
 		"endTagMissing:" : "sebastian.sastre 9/20/2010 11:53",
 		"flushBlockNode:to:" : "SN 5/25/2014 15:38",
 		"flushInlineNodes:to:" : "rs 6/13/2014 19:29:07.823",
-		"getHtmlBlockMorph" : "rs 6/8/2014 13:17:59.51",
+		"getHtmlBlockMorph" : "rs 6/28/2014 14:01:51.067",
 		"hasTrailingSlash" : "tb 1/3/2006 17:29",
 		"hasTrailingSlash:" : "sebastian.sastre 9/20/2010 11:53",
 		"id" : "tb 7/12/2007 11:07",
@@ -50,6 +50,7 @@
 		"parseContents:" : "SebastianSastre 1/15/2012 16:40",
 		"rawTag" : "tb 12/2/2005 20:33",
 		"recoverFromLTIn:stream:" : "tb 12/10/2005 21:41",
+		"renderChildrenInto:" : "rs 6/28/2014 14:01:31.325",
 		"startStyles:" : "rs 5/18/2014 15:33:41.852",
 		"styles" : "tb 12/30/2005 20:08",
 		"styles:" : "tb 12/30/2005 20:08",

packages/HTML.package/HtmlDocument.class/instance/addToHtmlMorph..st

@@ -0,0 +1,3 @@
+rendering
+addToHtmlMorph: aHtmlBlockMorph
+	self renderChildrenInto: aHtmlBlockMorph

packages/HTML.package/HtmlDocument.class/methodProperties.json

@@ -2,6 +2,7 @@
 	"class" : {
 		 },
 	"instance" : {
+		"addToHtmlMorph:" : "rs 6/28/2014 14:12:49.155",
 		"allStyles" : "tb 12/30/2005 20:49",
 		"applyStyles" : "tb 7/12/2007 12:55",
 		"associatedForm" : "rs 5/29/2014 23:11:28.394",

packages/HTML.package/HtmlHTMLNode.class/instance/addToHtmlMorph..st

@@ -0,0 +1,3 @@
+rendering
+addToHtmlMorph: aHtmlBlockMorph
+	self renderChildrenInto: aHtmlBlockMorph

packages/HTML.package/HtmlHTMLNode.class/methodProperties.json

@@ -2,5 +2,6 @@
 	"class" : {
 		 },
 	"instance" : {
+		"addToHtmlMorph:" : "rs 6/28/2014 14:02:09.556",
 		"createImpliedNodes" : "tb 12/1/2005 09:12",
 		"tag" : "tb 11/29/2005 09:19" } }

packages/HTML.package/monticello.meta/version

@@ -1 +1 @@
-fea643b6-5bbb-4b70-9584-e8f6b9377725
+d8a3e21d-3ec3-0944-bc0b-bbb4351006a8

packages/HTML.package/monticello.meta/version.d/HTML-rs.113_b49e40ea-38e5-3241-9e1a-5d692da8925f

@@ -0,0 +1 @@
+(name 'HTML-rs.113'message 'Fix scrollbars (and 6-digit-hex-color parsing)'id 'b49e40ea-38e5-3241-9e1a-5d692da8925f'date '4 July 2014'time '10:42:59.927 pm'author 'rs'ancestors ((id 'fea643b6-5bbb-4b70-9584-e8f6b9377725'))stepChildren ())

packages/HTML.package/monticello.meta/version.d/HTML-rs.114_d8a3e21d-3ec3-0944-bc0b-bbb4351006a8

@@ -0,0 +1 @@
+(name 'HTML-rs.114'message 'Fix two CSS parsing bugs'id 'd8a3e21d-3ec3-0944-bc0b-bbb4351006a8'date '5 July 2014'time '10:33:23.107 am'author 'rs'ancestors ((id 'b49e40ea-38e5-3241-9e1a-5d692da8925f'))stepChildren ())

packages/Scamper.package/HtmlBlockMorph.class/instance/adjustBoundsToSubmorphs.st

@@ -0,0 +1,23 @@
+layout
+adjustBoundsToSubmorphs
+"My bounds should always enclose the submorph's bounds"
+"(that's actually not 100% correct, e.g. take the case of "
+"<div style='width:100px'><div style='width:200px'></div></div>)."
+"If I don't have submorphs (e.g. I'm just background-image'd), take "
+"	my computedSize and the given position"
+"Otherwise take the submorphBounds and make sure they "
+"	have at least an extent of computedSize (the resulting bounds "
+"	may reside completely in the negative space because of "
+"	TextMorph's submorph placement - see BitBltDisplayScanner)."
+"	However it's important to set a correct width as it is used"
+"	for table column breadth ratio calulation"
+	| submorphCorner delta |
+	submorphCorner := self submorphs 
+		ifEmpty: [ self position + self computedSize ]
+		ifNotEmpty: [ ((self submorphBounds origin extent: self computedSize) quickMerge: self submorphBounds) corner asIntegerPoint ].
+	delta := submorphCorner - self bounds corner.
+	(delta isZero)
+		ifTrue: [ ^ false ]
+		ifFalse: 
+			[ self extent: submorphCorner - self position. 
+			  ^true ]

packages/Scamper.package/HtmlBlockMorph.class/instance/computedSize.st

@@ -0,0 +1,4 @@
+accessing
+computedSize
+
+	^ self computedWidth @ self cssHeight

packages/Scamper.package/HtmlBlockMorph.class/instance/computedWidth..st

@@ -0,0 +1,5 @@
+accessing
+computedWidth: aWidth
+
+	computedWidth := aWidth.
+	self layoutChanged

packages/Scamper.package/HtmlBlockMorph.class/instance/computedWidth.st

@@ -0,0 +1,4 @@
+accessing
+computedWidth
+
+	^ computedWidth ifNil: [ 0 ]

packages/Scamper.package/HtmlBlockMorph.class/instance/cornerOf.relativeTo..st

@@ -0,0 +1,5 @@
+layout
+cornerOf: aRectangle relativeTo: aPoint
+	| translation |
+	translation := aPoint - aRectangle origin.
+	^ aRectangle corner - translation

packages/Scamper.package/HtmlBlockMorph.class/instance/cssHeight.st

@@ -0,0 +1,8 @@
+layout
+cssHeight
+
+	| resolver |
+	self node ifNil: [ ^ 0 ].
+
+	resolver := CSSStyleResolver for: node.
+ 	^ resolver ifStyleNotNil: #height do: [:value | value ] ifNil: [ 0 ]

packages/Scamper.package/HtmlBlockMorph.class/instance/defaultBounds.st

@@ -1,4 +1,4 @@
 initialization
 defaultBounds
 "answer the default bounds for the receiver"
-	^ 0 @ 0 corner: self cssSize
+	^ 0 @ 0 corner: self computedSize

packages/Scamper.package/HtmlBlockMorph.class/instance/drawBackground.withRepeat.On..st

@@ -3,6 +3,7 @@ drawBackground: anImage withRepeat: repeat On: aCanvas
 	| fillBounds fillStyle |
 	fillBounds := self bounds.
 	fillStyle := BitmapFillStyle fromForm: anImage.
+	fillStyle origin: fillBounds origin.
 
 	(repeat == #repeatX or: [ repeat == #noRepeat])
 		ifTrue: [ fillBounds := fillBounds withHeight: anImage height ].

packages/Scamper.package/HtmlBlockMorph.class/instance/isHtmlBlockMorph.st

@@ -0,0 +1,3 @@
+testing
+isHtmlBlockMorph
+	^ true

packages/Scamper.package/HtmlBlockMorph.class/instance/isHtmlBodyMorph.st

@@ -0,0 +1,3 @@
+testing
+isHtmlBodyMorph
+	^ false

packages/Scamper.package/HtmlBlockMorph.class/instance/layoutChanged.st

@@ -1,10 +1,6 @@
 layout
 layoutChanged
-	| delta submorphCorner |
-	submorphCorner := self submorphs 
-		ifEmpty: [ self defaultBounds corner ]
-		ifNotEmpty: [ (self defaultBounds quickMerge: self submorphBounds) corner asIntegerPoint ].
-	delta := submorphCorner - self bounds corner.
-	(delta isZero)
-		ifTrue: [ super layoutChanged ]
-		ifFalse: [ self extent: submorphCorner - self position ]
+	self suppressLayoutUpdates ifTrue: [ ^ self ].
+
+	self adjustBoundsToSubmorphs
+		ifFalse: [ super layoutChanged ]

packages/Scamper.package/HtmlBlockMorph.class/instance/preferredMinimumWidth.st

@@ -0,0 +1,19 @@
+layout
+preferredMinimumWidth
+	| resolver ownWidth childrenWidth |
+	self node ifNil: [ ^ #auto ].
+
+	resolver := CSSStyleResolver for: node.
+
+	"TODO: add support for intrinsic widths of replaced elements here"
+	"add margins and paddings and border-widths here"
+	resolver ifStyleNotNil: #absoluteWidth do: [:value | ownWidth := value ] ifNil: [ ^ ownWidth := #auto ].
+
+	childrenWidth := (self submorphs 
+		collect: [ :morph | morph preferredMinimumWidth ]
+		thenSelect: [ :width | width ~= #auto ])
+		ifNotEmpty: [ :widths | widths max ] ifEmpty: [ #auto ].
+
+	(ownWidth == #auto)
+		ifTrue: [ ^ childrenWidth ]
+		ifFalse: [ ^ ownWidth ]

packages/Scamper.package/HtmlBlockMorph.class/instance/setWidth..st

@@ -0,0 +1,20 @@
+layout
+setWidth: availableWidth
+
+	| resolver absoluteWidth relativeWidth resultWidth |
+	self node ifNil: [ ^ self ].
+
+	resolver := CSSStyleResolver for: node.
+
+	absoluteWidth := (resolver getStyle: #absoluteWidth) ifNil: [ #auto ].
+	relativeWidth := (resolver getStyle: #relativeWidth) ifNil: [ 100 ].
+	(absoluteWidth == #auto) 
+		ifTrue: [ 
+			"subtract margin, padding border-width here"
+			resultWidth := availableWidth * relativeWidth / 100 ]
+		ifFalse: [ resultWidth := absoluteWidth ].
+	self computedWidth: resultWidth;
+		suppressLayoutUpdates: true;
+		updateSubmorphWidth: resultWidth;
+		suppressLayoutUpdates: false;
+		layoutChanged