Fixes Auto Refactoring for the BPBrowser

packages/Babylonian-Compiler.package/BPCompiler.class/instance/compile.ifFail..st

@@ -1,20 +1,33 @@
 public access
-compile: aCueWithBPSource ifFail: failBlock
+compile: aCueWithStyledSource ifFail: failBlock
 
-	"This method expects source code which has annotations embedded in comments, if any."
-	| originalMethodNode bpSource basicCue |
-	bpSource := aCueWithBPSource sourceStream contents asString.
-	basicCue := CompilationCue
-		source: bpSource readStream
-		context: aCueWithBPSource context 
-		receiver: aCueWithBPSource receiver 
-		class: aCueWithBPSource getClass 
-		environment: aCueWithBPSource environment 
-		requestor: aCueWithBPSource requestor.
-	originalMethodNode := super compile: basicCue ifFail: failBlock.
+	"This method expects source code which has annotations embedded in comments, 
+	if any, meaning it's styled with text attributes. Since the BPBrowser breaks the premise 
+	of the Parser that the source stream and the code panel's morph code is the same, auto
+	refactoring will quickly cause inconsistencies. For example, if one were to add a temporal 
+	variable to existing ones, with the second vertical line being at position 18, the styled 
+	version could have it at position 19. The parser would then re-add two lines,
+	causing for synctactic errors when compiling. Therefore, we remove the text styling
+	inside the morph to re-fullfill that premise again during compilation."
+	| originalMethodNode bpUnstyledSource unstyledCue |
+	bpUnstyledSource := aCueWithStyledSource sourceStream contents asString asBPSource.
+	aCueWithStyledSource requestor ifNotNil: [
+		aCueWithStyledSource requestor useDefaultStyler.
+		aCueWithStyledSource requestor setText: bpUnstyledSource.
+		aCueWithStyledSource requestor styler: (BPStyler new view: aCueWithStyledSource requestor).
+		].
 
-	bpSource := originalMethodNode sourceText asString.
-	(self methodSourceRequiresBPLayers: bpSource) ifTrue: [
-		(self compileInstrumentedVersionOf: aCueWithBPSource) ifFalse: failBlock].
-
-	^ originalMethodNode
+	unstyledCue := CompilationCue
+		source: bpUnstyledSource readStream
+		context: aCueWithStyledSource context
+		receiver: aCueWithStyledSource receiver 
+		class: aCueWithStyledSource getClass 
+		environment: aCueWithStyledSource environment 
+		requestor: aCueWithStyledSource requestor.
+	originalMethodNode := super compile: unstyledCue ifFail: failBlock.
+
+	bpUnstyledSource := originalMethodNode sourceText asString.
+	(self methodSourceRequiresBPLayers: bpUnstyledSource) ifTrue: [
+		(self compileInstrumentedVersionOf: aCueWithStyledSource) ifFalse: failBlock].	
+
+	 ^ originalMethodNode

packages/Babylonian-Compiler.package/BPCompiler.class/methodProperties.json

@@ -6,8 +6,8 @@
 	"instance" : {
 		"annotationKeywords" : "pre 11/8/2019 20:29",
 		"backgroundCompileInstrumentedVersionOf:basedOn:" : "pre 10/12/2020 15:36",
-		"compile:ifFail:" : "pre 5/3/2021 10:59",
-		"compileInstrumentedVersionOf:" : "pre 1/11/2021 15:51",
+		"compile:ifFail:" : "jb 10/17/2021 19:02",
+		"compileInstrumentedVersionOf:" : "jb 9/9/2021 17:31",
 		"keywords" : "pre 7/26/2019 14:00",
 		"methodSourceRequiresBPLayers:" : "pre 11/11/2019 15:49",
 		"parse:" : "pre 1/11/2021 15:51",

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/class/compilerClass.st

@@ -0,0 +1,4 @@
+compiling
+compilerClass
+
+	^ BPCompiler

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/assertText..st

@@ -0,0 +1,10 @@
+assertions
+assertText: textMatch
+
+	text isBlock ifTrue: [
+		^ self assertText: text value].
+	^ (textMatch respondsTo: #matches:)
+		ifTrue: [
+			self assert: [textMatch matches: (self codePaneTextMorph textMorph contents) asString]]
+		ifFalse: [
+			self assert: textMatch equals: (self codePaneTextMorph textMorph contents) asString]

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/codePaneTextMorph.st

@@ -0,0 +1,4 @@
+private
+codePaneTextMorph
+
+	^ browser containingWindow submorphNamed: 'codePaneTextMorph'.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/compile..st

@@ -0,0 +1,14 @@
+private
+compile: sourceString
+
+	| result |
+	originalText := text := sourceString.
+	previousSelection := originalSelection := 1 to: text size + 1.
+	selectionInterval := nil.
+	result := self class
+		compile: text
+		classified: 'generated'
+		notifying: self codePaneTextMorph.
+	result ifNil: [^ self].
+	self codePaneTextMorph accept.
+	selectionInterval := originalSelection.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/compileMethodHeaderAndSetBrowserToIt.st

@@ -0,0 +1,6 @@
+private
+compileMethodHeaderAndSetBrowserToIt
+
+	text := 'someMethod\\	' withCRs asText.
+	self compile: text.
+	browser setSelector: #someMethod.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/compiling.shouldRaise.andSelect.testing..st

@@ -0,0 +1,16 @@
+private
+compiling: sourceCode shouldRaise: exceptionClass andSelect: selectionMatch testing: tests
+
+	"See CompilerException"
+
+	| referenceTest |
+	referenceTest := [] -> [].
+	(tests copyWithFirst: referenceTest) associationsDo: [:test |
+		self
+			should: [self compile: sourceCode.]
+			raise: exceptionClass
+			thenDo: [:exception |
+				previousSelection := self selectionInterval.
+				(self handlerBlockFor: test key) cull: exception].
+		self codePaneTextMorph accept.
+		(self testBlockFor: test value) value].

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/setUp.st

@@ -0,0 +1,7 @@
+running
+setUp
+
+	browser := BPBrowser fullOnClass: self class.
+	stylePreference := Preferences confirmFirstUseOfStyle.
+	Preferences setPreference: #confirmFirstUseOfStyle toValue: false.
+	self compileMethodHeaderAndSetBrowserToIt.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/tearDown.st

@@ -0,0 +1,7 @@
+running
+tearDown
+
+	self codePaneTextMorph accept.
+	super tearDown.
+	browser containingWindow abandon.
+	Preferences setPreference: #confirmFirstUseOfStyle toValue: stylePreference.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testAmbiguousSelector.st

@@ -0,0 +1,14 @@
+tests
+testAmbiguousSelector
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: '\^1@-1' withCRs.
+	text append:  '\^1@-1' withCRs.	
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	\^1@ -1') withCRs.
+	self 
+		compiling: text
+		shouldRaise: AmbiguousSelector
+		andSelect: '@-'
+		testing: {
+			[:ex | ex resume] -> [self assertCanceled].
+			[:ex | ex resume: '@ -'] -> expectedString }.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesBlockLocalTemp.st

@@ -0,0 +1,14 @@
+tests
+testPastesBlockLocalTemp
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	text append:  ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	expectedString := ('someMethod\', Character startOfHeader, '\	\^ [ | foo | ', self undeclaredVar, ' ] value') withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare block-local temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesFirstTempAtMethodLevel.st

@@ -0,0 +1,14 @@
+tests
+testPastesFirstTempAtMethodLevel
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: self undeclaredVar.
+	text append: self undeclaredVar.
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	\| foo |', self undeclaredVar) withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare method temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesSecondTempAtMethodLevel.st

@@ -0,0 +1,14 @@
+tests
+testPastesSecondTempAtMethodLevel
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: ('| a | \ a := 3.', self undeclaredVar) withCRs.
+	text append:  ('| a | \ a := 3.', self undeclaredVar) withCRs.
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	| a foo | \ a := 3.', self undeclaredVar) withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare method temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesTempForBlockValue.st

@@ -0,0 +1,14 @@
+tests
+testPastesTempForBlockValue
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	text append: ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	\| foo |\^ [ ', self undeclaredVar, ' ] value') withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare method temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testUndefinedVariable.st

@@ -0,0 +1,13 @@
+tests
+testUndefinedVariable
+
+
+	self codePaneTextMorph textMorph contents append: '| foo | ^ foo'.
+	text append: '| foo | ^ foo'.
+	self 
+		compiling: text
+		shouldRaise: UndefinedVariable
+		andSelect: [(self text allRangesOfRegexMatches: '(?<=\^ )foo') first]
+		testing: {
+			true -> [self assertSucceeded].
+			false -> [self assertCanceled] }.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testUndefinedVariableBlockValue.st

@@ -0,0 +1,12 @@
+tests
+testUndefinedVariableBlockValue
+
+	self codePaneTextMorph textMorph contents append: '[ | foo | ^ foo ] value'.
+	text append: '[ | foo | ^ foo ] value'.	
+	self 
+		compiling: text
+		shouldRaise: UndefinedVariable
+		andSelect: [(self text allRangesOfRegexMatches: '(?<=\^ )foo') first]
+		testing: {
+			true -> [self assertSucceeded].
+			false -> [self assertCanceled] }.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testUnusedVariable.st

@@ -0,0 +1,13 @@
+tests
+testUnusedVariable
+
+	self codePaneTextMorph textMorph contents append: '| foo | ^nil'.
+	text append: '| foo | ^nil'.	
+	self 
+		compiling: text
+		shouldRaise: UnusedVariable
+		andSelect: [text]
+		testing: {
+			[:ex | ex resume] -> [self assertCanceled].
+			false -> [self assertSucceeded].
+			true -> [self assertSucceeded: ('someMethod\' withCRs, Character startOfHeader, '\s*\^nil') asRegex] }.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testUnusedVariableInBlock.st

@@ -0,0 +1,13 @@
+tests
+testUnusedVariableInBlock
+
+	self codePaneTextMorph textMorph contents append: '^[ | foo | ]'.
+	text append: '^[ | foo | ]'.	
+	self 
+		compiling: text
+		shouldRaise: UnusedVariable
+		andSelect: [text]
+		testing: {
+			[:ex | ex resume] -> [self assertCanceled].
+			false -> [self assertSucceeded].
+			true -> [self assertSucceeded: ('someMethod\' withCRs, Character startOfHeader, '\s*\^\[\s*\]') asRegex] }.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/undeclaredVar.st

@@ -0,0 +1,4 @@
+private
+undeclaredVar
+
+	^ '\foo := 42.' withCRs

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/methodProperties.json

@@ -0,0 +1,21 @@
+{
+	"class" : {
+		"compilerClass" : "jb 10/24/2021 01:58" },
+	"instance" : {
+		"assertText:" : "jb 10/24/2021 02:51",
+		"codePaneTextMorph" : "jb 10/20/2021 18:18",
+		"compile:" : "jb 10/24/2021 03:09",
+		"compileMethodHeaderAndSetBrowserToIt" : "jb 10/24/2021 01:52",
+		"compiling:shouldRaise:andSelect:testing:" : "jb 10/24/2021 03:03",
+		"setUp" : "jb 10/24/2021 02:11",
+		"tearDown" : "jb 10/24/2021 02:26",
+		"testAmbiguousSelector" : "jb 10/24/2021 22:41",
+		"testPastesBlockLocalTemp" : "jb 10/24/2021 22:41",
+		"testPastesFirstTempAtMethodLevel" : "jb 10/24/2021 22:41",
+		"testPastesSecondTempAtMethodLevel" : "jb 10/24/2021 22:41",
+		"testPastesTempForBlockValue" : "jb 10/24/2021 22:41",
+		"testUndefinedVariable" : "jb 10/24/2021 02:34",
+		"testUndefinedVariableBlockValue" : "jb 10/24/2021 02:37",
+		"testUnusedVariable" : "jb 10/24/2021 22:42",
+		"testUnusedVariableInBlock" : "jb 10/24/2021 22:42",
+		"undeclaredVar" : "jb 10/23/2021 16:49" } }

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/properties.json

@@ -0,0 +1,15 @@
+{
+	"category" : "Babylonian-Tests",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		"browser",
+		"stylePreference" ],
+	"name" : "BPCompilerExceptionTest",
+	"pools" : [
+		 ],
+	"super" : "CompilerExceptionsTest",
+	"type" : "normal" }

packages/Babylonian-UI.package/BPAnnotationMorph.class/class/smallFontHeight.st

@@ -1,4 +1,4 @@
 ui constants
 smallFontHeight
 
-	^ self fontHeight * 0.75
+	^ self fontHeight * 0.75 

packages/Babylonian-UI.package/BPAnnotationMorph.class/methodProperties.json

@@ -3,7 +3,7 @@
 		"fontHeight" : "pre 11/18/2019 10:40",
 		"fontWidth" : "pre 11/18/2019 10:44",
 		"newContainerMorph" : "pre 10/12/2020 17:47",
-		"smallFontHeight" : "pre 10/6/2020 11:54",
+		"smallFontHeight" : "jb 9/9/2021 18:39",
 		"smallFontWidth" : "pre 1/7/2021 11:49" },
 	"instance" : {
 		"annotation" : "pre 7/2/2019 16:39",

packages/Babylonian-UI.package/BPStyler.class/instance/unstyledTextFrom..st

@@ -1,4 +1,10 @@
 converting
 unstyledTextFrom: aText
 
-	^ Text fromString: aText asBPSource
+	| answer |	
+	answer := Text fromString: aText asBPSource.
+	aText runs withStartStopAndValueDo: [:start :stop :attribs |
+		(attribs anySatisfy: [:each | each shoutShouldPreserve])
+			ifTrue: [
+				attribs do: [:eachAttrib |answer addAttribute: eachAttrib from: start to: stop]]].
+	^answer

packages/Babylonian-UI.package/BPStyler.class/methodProperties.json

@@ -23,4 +23,4 @@
 		"removePotentialEmptyLinesInText:around:" : "pre 8/25/2020 09:47",
 		"selectedMethod:" : "ct 8/20/2021 06:24",
 		"textForAnnotation:from:at:" : "pre 11/23/2020 11:57",
-		"unstyledTextFrom:" : "lu 6/1/2021 21:39" } }
+		"unstyledTextFrom:" : "jb 10/24/2021 03:17" } }

packages/Babylonian-UI.package/BPTextReadWriter.class/instance/writeStartTagFor..st

@@ -1,5 +1,5 @@
 writing
 writeStartTagFor: aTextAttribute
-
+	
 	[self nextPutAll: aTextAttribute anchoredMorph startTag]
 		on: MessageNotUnderstood do: [].

packages/Babylonian-UI.package/BPTextReadWriter.class/methodProperties.json

@@ -13,4 +13,4 @@
 		"respectExamples" : "pre 1/11/2021 14:54",
 		"writeContent:" : "jb 12/7/2020 19:03",
 		"writeEndTagFor:" : "jb 12/7/2020 19:03",
-		"writeStartTagFor:" : "jb 12/7/2020 19:03" } }
+		"writeStartTagFor:" : "jb 8/31/2021 00:29" } }