[squeak-dev] The Trunk: Morphic-nice.527.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Apr 2 19:18:17 UTC 2011


Nicolas Cellier uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-nice.527.mcz

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

Name: Morphic-nice.527
Author: nice
Time: 31 March 2011, 10:01:14.852 pm
UUID: 09a44c8f-9a17-4486-b991-044da167e378
Ancestors: Morphic-nice.526

Get rid of FakeClassPool and #failedDoIt references.
This is implemented by the mean of #evaluateSelectionAndDo:
This method will pass the result to aBlock argument in case of success, and avoid testing for arbitrary return value (FakeClassPool new or #failedDoit)

=============== Diff against Morphic-nice.526 ===============

Item was changed:
  ----- Method: PluggableTextMorph>>exploreIt (in category 'menu commands') -----
  exploreIt
  
  	
+ 	self handleEdit:
+ 		[textMorph editor evaluateSelectionAndDo: [:result | result explore]].!
- 	self handleEdit: [ | result |
- 		result := textMorph editor evaluateSelection.
- 		((result isKindOf: FakeClassPool) or: [result == #failedDoit])
- 			ifTrue: [self flash]
- 			ifFalse: [result explore]].!

Item was changed:
  ----- Method: PluggableTextMorph>>inspectIt (in category 'menu commands') -----
  inspectIt
  	
  	self handleEdit:
+ 		[textMorph editor evaluateSelectionAndDo: [:result | result inspect]]!
- 		[ | result |
- 		result := textMorph editor evaluateSelection.
- 		((result isKindOf: FakeClassPool) or: [result == #failedDoit])
- 			ifTrue: [self flash]
- 			ifFalse: [result inspect]]!

Item was changed:
  ----- Method: PluggableTextMorph>>printIt (in category 'menu commands') -----
  printIt
+ 	| oldEditor |
- 	| result oldEditor |
- 
  	textMorph editor selectFrom: selectionInterval first to: selectionInterval last;
  						model: model.  "For, eg, evaluateSelection"
+ 	textMorph handleEdit: [(oldEditor := textMorph editor) evaluateSelectionAndDo:
+ 		[:result |
+ 		selectionInterval := oldEditor selectionInterval.
+ 		textMorph installEditorToReplace: oldEditor.
+ 		textMorph handleEdit: [oldEditor afterSelectionInsertAndSelect: result printString].
+ 		selectionInterval := oldEditor selectionInterval.
- 	result := textMorph handleEdit: [(oldEditor := textMorph editor) evaluateSelection].
- 	((result isKindOf: FakeClassPool) or: [result == #failedDoit]) ifTrue: [^self flash].
- 	selectionInterval := oldEditor selectionInterval.
- 	textMorph installEditorToReplace: oldEditor.
- 	textMorph handleEdit: [oldEditor afterSelectionInsertAndSelect: result printString].
- 	selectionInterval := oldEditor selectionInterval.
  	
+ 		textMorph editor selectFrom: selectionInterval first to: selectionInterval last.
+ 		self scrollSelectionIntoView]]!
- 	textMorph editor selectFrom: selectionInterval first to: selectionInterval last.
- 	self scrollSelectionIntoView.
- 
- !

Item was changed:
  ----- Method: PluggableTextMorph>>tileForIt (in category 'menu commands') -----
  tileForIt
  	"Return a tile referring to the object resulting form evaluating my current selection.  Not currently threaded in, but useful in earlier demos and possibly still of value."
  
  	
  	self handleEdit:
+ 		[textMorph editor evaluateSelectionAndDo: [:result | self currentHand attachMorph: result tileToRefer]]!
- 		[ | result |
- 		result := textMorph editor evaluateSelection.
- 		((result isKindOf: FakeClassPool) or: [result == #failedDoit])
- 			ifTrue: [self flash]
- 			ifFalse: [self currentHand attachMorph: result tileToRefer]]!

Item was changed:
  ----- Method: SmalltalkEditor>>tallySelection (in category 'do-its') -----
  tallySelection
  	"Treat the current selection as an expression; evaluate it and return the time took for this evaluation"
  	| result rcvr ctxt valueAsString v |
+ 	self lineSelectAndEmptyCheck: [^ self].
- 	self lineSelectAndEmptyCheck: [^ -1].
  
  	(model respondsTo: #doItReceiver) 
  		ifTrue: [ rcvr := model doItReceiver.
  				ctxt := model doItContext]
  		ifFalse: [rcvr := ctxt := nil].
  	result := [ | cm |
  		cm := rcvr class evaluatorClass new 
  			compiledMethodFor: self selectionAsStream
  			in: ctxt
  			to: rcvr
  			notifying: self
+ 			ifFail: [morph flash. ^ self]
- 			ifFail: [^ #failedDoit]
  			logged: false.
  		Time millisecondsToRun: 
  			[v := cm valueWithReceiver: rcvr arguments: #() ].
  	] 
  		on: OutOfScopeNotification 
  		do: [ :ex | ex resume: true].
  
  	"We do not want to have large result displayed"
  	valueAsString := v printString.
  	(valueAsString size > 30) ifTrue: [valueAsString := (valueAsString copyFrom: 1 to: 30), '...'].
  	PopUpMenu 
  		inform: 'Time to compile and execute: ', result printString, 'ms res: ', valueAsString.
  !

Item was changed:
  ----- Method: TextEditor>>evaluateSelection (in category 'do-its') -----
  evaluateSelection
  	"Treat the current selection as an expression; evaluate it and return the result"
+ 	
+ 	^self evaluateSelectionAndDo: [:result | result]!
- 	| result rcvr ctxt |
- 	self lineSelectAndEmptyCheck: [^ ''].
- 
- 	(model respondsTo: #doItReceiver) 
- 		ifTrue: [ rcvr := model doItReceiver.
- 				ctxt := model doItContext]
- 		ifFalse: [rcvr := ctxt := nil].
- 	result := [
- 		rcvr class evaluatorClass new 
- 			evaluate: self selectionAsStream
- 			in: ctxt
- 			to: rcvr
- 			notifying: self
- 			ifFail: [^ #failedDoit]
- 			logged: true.
- 	] 
- 		on: OutOfScopeNotification 
- 		do: [ :ex | ex resume: true].
- 	^ result!

Item was added:
+ ----- Method: TextEditor>>evaluateSelectionAndDo: (in category 'do-its') -----
+ evaluateSelectionAndDo: aBlock
+ 	"Treat the current selection as an expression; evaluate it and invoke aBlock with the result."
+ 	| result rcvr ctxt |
+ 	self lineSelectAndEmptyCheck: [^ nil].
+ 
+ 	(model respondsTo: #doItReceiver) 
+ 		ifTrue: [ rcvr := model doItReceiver.
+ 				ctxt := model doItContext]
+ 		ifFalse: [rcvr := ctxt := nil].
+ 	result := [
+ 		rcvr class evaluatorClass new 
+ 			evaluate: self selectionAsStream
+ 			in: ctxt
+ 			to: rcvr
+ 			notifying: self
+ 			ifFail: [morph flash. ^ nil]
+ 			logged: true.
+ 	] 
+ 		on: OutOfScopeNotification 
+ 		do: [ :ex | ex resume: true].
+ 	^aBlock value: result!

Item was changed:
  ----- Method: TextEditor>>exploreIt (in category 'do-its') -----
  exploreIt
+ 	self evaluateSelectionAndDo: [:result | result explore]!
- 	| result |
- 	result := self evaluateSelection.
- 	((result isKindOf: FakeClassPool) or: [result == #failedDoit])
- 			ifTrue: [morph flash]
- 			ifFalse: [result explore]!

Item was changed:
  ----- Method: TextEditor>>inspectIt (in category 'do-its') -----
  inspectIt
+ 	 self evaluateSelectionAndDo: [:result | result inspect]!
- 	"1/13/96 sw: minor fixup"
- 	| result |
- 	result := self evaluateSelection.
- 	((result isKindOf: FakeClassPool) or: [result == #failedDoit])
- 			ifTrue: [morph flash]
- 			ifFalse: [result inspect]!

Item was changed:
  ----- Method: TextEditor>>printIt (in category 'do-its') -----
  printIt
+ 	self evaluateSelectionAndDo:
+ 		[:result | self afterSelectionInsertAndSelect: result printString]!
- 	"Treat the current text selection as an expression; evaluate it. Insert the 
- 	description of the result of evaluation after the selection and then make 
- 	this description the new text selection."
- 	| result |
- 	result := self evaluateSelection.
- 	((result isKindOf: FakeClassPool) or: [result == #failedDoit])
- 			ifTrue: [morph flash]
- 			ifFalse: [self afterSelectionInsertAndSelect: result printString]!




More information about the Squeak-dev mailing list