'From Cuis 2.0 of 24 February 2010 [latest update: #440] on 18 March 2010 at 11:19:37 pm'!

!Compiler methodsFor: 'private' stamp: 'jmv 3/18/2010 22:41'!
translate: aStream noPattern: noPattern ifFail: failBlock
	^self parser
		sourceStreamGetter: sourceStreamGetter;
		parse: aStream
		class: class
		category: category
		noPattern: noPattern
		context: context
		notifying: requestor
		ifFail: [^failBlock value]! !


!Parser methodsFor: 'error correction' stamp: 'jmv 3/18/2010 22:45'!
correctSelector: proposedKeyword wordIntervals: spots exprInterval: expInt ifAbort: abortAction
	"Correct the proposedKeyword to some selector symbol, correcting the original text if such action is indicated.  abortAction is invoked if the proposedKeyword couldn't be converted into a valid selector.  Spots is an ordered collection of intervals within the test stream of the for each of the keyword parts."

	| correctSelector userSelection |
	"If we can't ask the user, assume that the keyword will be defined later"
	self interactive ifFalse: [^proposedKeyword asSymbol].
	
	"If the requestor is of an exotic kind (like a telnet server) we might not be allowed to open a PupUpMenu for querying the user"
	"
	((requestor isKindOf: Editor) or: [ requestor is: #Morph ])
		ifFalse: [ ^ proposedKeyword asSymbol ].
	"

	userSelection _ requestor selectionInterval.
	requestor selectFrom: spots first first to: spots last last.
	doitFlag
		ifTrue: [requestor setViewSelection]
		ifFalse: [requestor selectionInterval: requestor selectionInterval].

	correctSelector _ UnknownSelector name: proposedKeyword.
	correctSelector ifNil: [^abortAction value].

	requestor deselect.
	requestor selectInvisiblyFrom: userSelection first to: userSelection last.

	self substituteSelector: correctSelector keywords wordIntervals: spots.
	^(proposedKeyword last ~~ $:
	   and: [correctSelector last == $:])
		ifTrue: [abortAction value]
		ifFalse: [correctSelector]! !

!Parser methodsFor: 'error correction' stamp: 'jmv 3/18/2010 22:46'!
correctVariable: proposedVariable interval: spot
	"Correct the proposedVariable to a known variable, or declare it as a new
	variable if such action is requested.  We support declaring lowercase
	variables as temps or inst-vars, and uppercase variables as Globals or 
	ClassVars, depending on whether the context is nil (class=UndefinedObject).
	Spot is the interval within the test stream of the variable.
	rr 3/4/2004 10:26 : adds the option to define a new class. "

	"Check if this is an i-var, that has been corrected already (ugly)"

	"Display the pop-up menu"

	| tempIvar binding userSelection action |
	(encoder classEncoding instVarNames includes: proposedVariable) ifTrue: 
		[^InstanceVariableNode new 
			name: proposedVariable
			index: (encoder classEncoding allInstVarNames indexOf: proposedVariable)].

	"If we can't ask the user for correction, make it undeclared"
	self interactive ifFalse: [^encoder undeclared: proposedVariable].

	"First check to see if the requestor knows anything about the variable"
	tempIvar _ proposedVariable first isLowercase.
	(tempIvar and: [(binding _ requestor bindingOf: proposedVariable) notNil]) 
		ifTrue: [^encoder global: binding name: proposedVariable].
	
	"If the requestor is of an exotic kind (like a telnet server) we might not be allowed to open a PupUpMenu for querying the user"
	"
	((requestor isKindOf: Editor) or: [ requestor is: #Morph ])
		ifFalse: [ ^encoder undeclared: proposedVariable ].
	"
	userSelection _ requestor selectionInterval.
	requestor selectFrom: spot first to: spot last.
	doitFlag
		ifTrue: [requestor setViewSelection]
		ifFalse: [requestor selectionInterval: requestor selectionInterval].

	"Build the menu with alternatives"
	action _ UndeclaredVariable 
				signalFor: self
				name: proposedVariable
				inRange: spot.
	action ifNil: [^self fail].

	"Execute the selected action"
	requestor deselect.
	requestor selectInvisiblyFrom: userSelection first to: userSelection last.
	^action value! !

!Parser methodsFor: 'error correction' stamp: 'cao 3/16/2010 13:49'!
removeUnusedTemps
	"Scan for unused temp names, and prompt the user about the prospect of removing each one found"

	| str end start madeChanges | 
	madeChanges := false.
	str := requestor text asString.
	((tempsMark between: 1 and: str size)
		and: [(str at: tempsMark) = $|]) ifFalse: [^ self].
	encoder unusedTempNames do:
		[:temp |
		(UnusedVariable name: temp) ifTrue:
			[(encoder encodeVariable: temp) isUndefTemp
				ifTrue:
					[end := tempsMark.
					["Beginning at right temp marker..."
					start := end - temp size + 1.
					end < temp size or: [temp = (str copyFrom: start to: end)
							and: [(str at: start-1) tokenish not & (str at: end+1) tokenish not]]]
						whileFalse:
							["Search left for the unused temp"
							end := requestor nextTokenFrom: end direction: -1].
					end < temp size ifFalse:
						[(str at: start-1) = $  ifTrue: [start := start-1].
						requestor correctFrom: start to: end with: ''.
						str := str copyReplaceFrom: start to: end with: ''. 
						madeChanges := true.
						tempsMark := tempsMark - (end-start+1)]]
				ifFalse:
					[self inform:
'You''ll first have to remove the\statement where it''s stored into' withCRs]]].
	madeChanges ifTrue: [ReparseAfterSourceEditing signal]! !

!Parser methodsFor: 'public access' stamp: 'jmv 3/18/2010 22:58'!
parse: sourceStream class: class category: aCategory noPattern: noPattern context: ctxt notifying: req ifFail: aBlock
	"Answer a MethodNode for the argument, sourceStream, that is the root of
	 a parse tree. Parsing is done with respect to the argument, class, to find
	 instance, class, and pool variables; and with respect to the argument,
	 ctxt, to find temporary variables. Errors in parsing are reported to the
	 argument, req, if not nil; otherwise aBlock is evaluated. The argument
	 noPattern is a Boolean that is true if the the sourceStream does not
	 contain a method header (i.e., for DoIts)."

	| methNode repeatNeeded myStream s p |
	category _ aCategory.
	myStream _ sourceStream.
	[repeatNeeded _ false.
	 p _ myStream position.
	 s _ myStream upToEnd.
	 myStream position: p.
	 self encoder init: class context: ctxt notifying: self.
	 self init: myStream notifying: req failBlock: [^ aBlock value].
	 doitFlag _ noPattern.
	 failBlock_ aBlock.
	 [methNode _ self
					method: noPattern
					context: ctxt] 
		on: ReparseAfterSourceEditing 
		do:	[ :ex |
			repeatNeeded _ true.
			myStream _ sourceStreamGetter notNil
				ifTrue: [ requestor perform: sourceStreamGetter ]
				ifFalse: [ReadStream on: requestor text string]].
	 repeatNeeded] whileTrue:
		[encoder _ self encoder class new].
	methNode sourceText: s.
	^methNode
! !


!TextEditor methodsFor: 'accessing-selection' stamp: 'jmv 3/18/2010 22:42'!
selectionAsStream
	"Answer a ReadStream on the text in the paragraph that is currently  selected."

	^ReadWriteStream
		on: paragraph string
		from: self startIndex
		to: self stopIndex - 1! !


!SmalltalkEditor methodsFor: 'do-its' stamp: 'jmv 3/18/2010 22:38'!
compileSelectionFor: anObject in: evalContext
	| methodNode method |
	methodNode _ [Compiler new
		sourceStreamGetter: #selectionAsStream;
		compileNoPattern: self selectionAsStream
		in: anObject class
		context: evalContext
		notifying: self
		ifFail: [^nil]]
			on: OutOfScopeNotification
			do: [:ex | ex resume: true].
	method _ methodNode generate: #(0 0 0 0).
	^method copyWithTempsFromMethodNode: methodNode! !

!SmalltalkEditor methodsFor: 'do-its' stamp: 'jmv 3/18/2010 22:38'!
evaluateSelection
	"Treat the current selection as an expression; evaluate it and return the result"
	| result rcvr ctxt |
	self lineSelectAndEmptyCheck: [^ ''].

	(model respondsTo: #doItReceiver) 
		ifTrue: [FakeClassPool adopt: model selectedClass.  "Include model pool vars if any"
				rcvr _ model doItReceiver.
				ctxt _ model doItContext]
		ifFalse: [rcvr _ ctxt _ nil].
	result _ [
		rcvr class evaluatorClass new
			sourceStreamGetter: #selectionAsStream;
			evaluate: self selectionAsStream
			in: ctxt
			to: rcvr
			notifying: self
			ifFail: [FakeClassPool adopt: nil. ^ #failedDoit]
			logged: true.
	] 
		on: OutOfScopeNotification 
		do: [ :ex | ex resume: true].
	FakeClassPool adopt: nil.
	^ result! !

