'From Cuis 2.0 of 24 February 2010 [latest update: #440] on 1 March 2010 at 2:19:06 pm'!

!BlockNode methodsFor: 'code generation (closures)' stamp: 'jmv 3/1/2010 14:00'!
ifHasRemoteTempNodeEnsureInitializationStatementExists: rootNode
	"If a remoteTempNode has been added ensure a statement exists to initialize it."
	remoteTempNode notNil ifTrue: [
		(statements notEmpty
		  and: [statements first isAssignmentNode
		  and: [statements first variable isTemp
		  and: [statements first variable isIndirectTempVector]]])
			ifTrue: "If this is a decompiled tree, or if a temporary has been added later in
					the analysis then there already is a temp vector initialization node."
				[(statements first variable ~~ remoteTempNode) ifTrue:
					[statements first variable become: remoteTempNode].
				 statements first value numElements: remoteTempNode remoteTemps size]
			ifFalse:
				[statements addFirst: (remoteTempNode nodeToInitialize: rootNode encoder)]].! !

!BlockNode methodsFor: 'testing' stamp: 'jmv 3/1/2010 13:59'!
generateAsClosure
	"Answer if we're compiling under the closure regime.  If blockExtent has been set by
	analyseTempsWithin:rootNode: et al then we're compiling under the closure regime."
	^blockExtent notNil! !

!BlockNode methodsFor: 'printing' stamp: 'jmv 3/1/2010 14:00'!
printStatementsOn: aStream indent: levelOrZero
	| len shown thisStatement level |
	level := 1 max: levelOrZero.
	comment ifNotNil: [
		self printCommentOn: aStream indent: level.
		aStream crtab: level].
	len := shown := statements size.
	(levelOrZero = 0 "top level" and: [statements last isReturnSelf])
		ifTrue: [shown := 1 max: shown - 1]
		ifFalse: ["should a trailing nil be printed or not? Not if it is an implicit result."
				(arguments size = 0
				and: [len >= 1
				and: [(statements at: len) == NodeNil
				and: [len = 1
					or: [len > 1
						and: [(statements at: len - 1) isMessageNode
						and: [(statements at: len - 1) isNilIf]]]]]])
					ifTrue: [shown := shown - 1]].
	1 to: shown do: 
		[:i | 
		thisStatement := statements at: i.
		thisStatement printOn: aStream indent: level.
		i < shown ifTrue: [aStream nextPut: $.; crtab: level].
		(thisStatement comment notNil and: [thisStatement comment size > 0])
			ifTrue: [
				i = shown ifTrue: [aStream crtab: level].
				thisStatement printCommentOn: aStream indent: level.
				i < shown ifTrue: [aStream crtab: level]]]! !

!BlockNode methodsFor: 'printing' stamp: 'jmv 3/1/2010 14:00'!
printWithClosureAnalysisStatementsOn: aStream indent: levelOrZero
	| len shown thisStatement level |
	level := 1 max: levelOrZero.
	comment ifNotNil: [
		self printCommentOn: aStream indent: level.
		aStream crtab: level].
	len := shown := statements size.
	(levelOrZero = 0 "top level" and: [statements last isReturnSelf])
		ifTrue: [shown := 1 max: shown - 1]
		ifFalse: [(len = 1 and: [((statements at: 1) == NodeNil) & (arguments size = 0)])
					ifTrue: [shown := shown - 1]].
	1 to: shown do: 
		[:i | 
		thisStatement := statements at: i.
		thisStatement printWithClosureAnalysisOn: aStream indent: level.
		i < shown ifTrue: [aStream nextPut: $.; crtab: level].
		(thisStatement comment notNil and: [thisStatement comment size > 0])
			ifTrue: [
				i = shown ifTrue: [aStream crtab: level].
				thisStatement printCommentOn: aStream indent: level.
				i < shown ifTrue: [aStream crtab: level]]]! !


!Categorizer methodsFor: 'accessing' stamp: 'jmv 3/1/2010 14:02'!
classify: element under: heading suppressIfDefault: aBoolean
	"Store the argument, element, in the category named heading.   If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein"

	| catName catIndex elemIndex realHeading |
	((heading = NullCategory) or: [heading == nil])
		ifTrue: [realHeading _ Default]
		ifFalse: [realHeading _ heading asSymbol].
	(catName _ self categoryOfElement: element) = realHeading
		ifTrue: [^ self].  "done if already under that category"

	catName notNil ifTrue: [
		(aBoolean and: [realHeading = Default])
				ifTrue: [^ self].	  "return if non-Default category already assigned in memory"
		self removeElement: element].	"remove if in another category"

	(categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading].

	catIndex _ categoryArray indexOf: realHeading.
	elemIndex _ 
		catIndex > 1
			ifTrue: [categoryStops at: catIndex - 1]
			ifFalse: [0].
	[(elemIndex _ elemIndex + 1) <= (categoryStops at: catIndex) 
		and: [element >= (elementArray at: elemIndex)]] whileTrue.

	"elemIndex is now the index for inserting the element. Do the insertion before it."
	elementArray _ elementArray copyReplaceFrom: elemIndex to: elemIndex-1
						with: (Array with: element).

	"add one to stops for this and later categories"
	catIndex to: categoryArray size do: 
		[:i | categoryStops at: i put: (categoryStops at: i) + 1].

	(self listAtCategoryNamed: Default) size = 0 ifTrue: [self removeCategory: Default]! !


!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 3/1/2010 14:02'!
fileOutPostscriptOn: stream 
	"If the receiver has a postscript, put it out onto the stream.  "

	| aString |
	aString _ self postscriptString.
	(aString notNil and: [aString size > 0])
		ifTrue: [
			stream nextChunkPut: aString "surroundedBySingleQuotes".
			stream cr; cr]! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 3/1/2010 14:02'!
fileOutPreambleOn: stream 
	"If the receiver has a preamble, put it out onto the stream.  "

	| aString |
	aString _ self preambleString.
	(aString notNil and: [aString size > 0])
		ifTrue: [
			stream nextChunkPut: aString "surroundedBySingleQuotes".
			stream cr; cr]! !


!CharacterBlock methodsFor: 'printing' stamp: 'jmv 3/1/2010 14:02'!
printOn: aStream

	aStream nextPutAll: 'a CharacterBlock with index '.
	stringIndex printOn: aStream.
	(text notNil and: [text size> 0 and: [stringIndex between: 1 and: text size]])
		ifTrue: [aStream nextPutAll: ' and character '.
				(text at: stringIndex) printOn: aStream].
	aStream nextPutAll: ' and rectangle '.
	super printOn: aStream.
	textLine ifNotNil: [aStream cr; nextPutAll: ' in '.
				textLine printOn: aStream].
! !


!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 3/1/2010 14:02'!
endOfRun
	"Before arriving at the cursor location, the selection has encountered an 
	end of run. Answer false if the selection continues, true otherwise. Set 
	up indexes for building the appropriate CharacterBlock."

	| runLength lineStop |
	((characterIndex notNil and:
		[runStopIndex < characterIndex and: [runStopIndex < text size]])
			or:	[characterIndex == nil and: [lastIndex < line last]])
		ifTrue:	["We're really at the end of a real run."
				runLength _ (text runLengthFor: (lastIndex _ lastIndex + 1)).
				lineStop _ characterIndex		"scanning for index"
					ifNil: [ line last ].			"scanning for point"
				(runStopIndex _ lastIndex + (runLength - 1)) > lineStop
					ifTrue: 	[runStopIndex _ lineStop].
				self setStopConditions.
				^false].

	lastCharacter _ text at: lastIndex.
	characterPoint _ destX @ destY.
	((lastCharacter = Character space and: [alignment = CharacterScanner justifiedCode])
		or: [lastCharacter = Character tab and: [lastSpaceOrTabExtent notNil]])
		ifTrue: [lastCharacterExtent _ lastSpaceOrTabExtent].
	characterIndex
		ifNotNil: ["If scanning for an index and we've stopped on that index,
				then we back destX off by the width of the character stopped on
				(it will be pointing at the right side of the character) and return"
				runStopIndex = characterIndex
					ifTrue:	[self characterPointSetX: destX - lastCharacterExtent x.
							^true].
				"Otherwise the requested index was greater than the length of the
				string.  Return string size + 1 as index, indicate further that off the
				string by setting character to nil and the extent to 0."
				lastIndex _  lastIndex + 1.
				lastCharacter _ nil.
				self lastCharacterExtentSetX: 0.
				^true].

	"Scanning for a point and either off the end of the line or off the end of the string."
	runStopIndex = text size
		ifTrue:	["off end of string"
				lastIndex _  lastIndex + 1.
				lastCharacter _ nil.
				self lastCharacterExtentSetX: 0.
				^true].
	"just off end of line without crossing x"
	lastIndex _ lastIndex + 1.
	^true! !

!CharacterBlockScanner methodsFor: 'scanning' stamp: 'jmv 3/1/2010 14:16'!
characterBlockAtPoint: aPoint index: index in: textLine
	"This method is the Morphic characterBlock finder.  It combines
	MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:"
	| runLength lineStop done stopCondition |
	line _ textLine.
	rightMargin _ line rightMargin.
	lastIndex _ line first.
	self setStopConditions.		"also sets font"
	characterIndex _ index.  " == nil means scanning for point"
	characterPoint _ aPoint.
	(characterPoint == nil or: [characterPoint y > line bottom])
		ifTrue: [characterPoint _ line bottomRight].
	(text isEmpty or: [(characterPoint y < line top or: [characterPoint x < line left])
				or: [characterIndex notNil and: [characterIndex < line first]]])
		ifTrue:	[^ (CharacterBlock new stringIndex: line first text: text
					topLeft: line leftMargin@line top extent: 0 @ actualTextStyle initialLineGrid)
					textLine: line].
	destX _ leftMargin _ line leftMarginForAlignment: alignment.
	destY _ line top.
	runLength _ text runLengthFor: line first.
	lineStop _ characterIndex	"scanning for index"
		ifNil: [ line last ].			"scanning for point"
	runStopIndex _ lastIndex + (runLength - 1) min: lineStop.
	lastCharacterExtent _ 0 @ line lineHeight.
	spaceCount _ 0.

	done  _ false.
	[ done ] whileFalse: [
		stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
			in: text string rightX: characterPoint x
			stopConditions: stopConditions kern: kern.
		"see setStopConditions for stopping conditions for character block 	operations."
		self lastCharacterExtentSetX: (specialWidth ifNil: [ font widthOf: (text at: lastIndex) ]).
		(self perform: stopCondition) ifTrue: [
			^characterIndex
				ifNil: ["Result for characterBlockAtPoint: "
						(CharacterBlock new stringIndex: lastIndex
							text: text topLeft: characterPoint + (font descentKern @ 0)
							extent: lastCharacterExtent - (font baseKern @ 0))
									textLine: line]
				ifNotNil: ["Result for characterBlockForIndex: "
						(CharacterBlock new stringIndex: characterIndex
							text: text topLeft: characterPoint + ((font descentKern - kern max: 0)@ 0)
							extent: lastCharacterExtent)
									textLine: line]]]! !


!ClassBuilder methodsFor: 'class definition' stamp: 'jmv 3/1/2010 14:02'!
name: className subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe
	"Define a new class.
	If unsafe is true do not run any validation checks.
	This facility is provided to implement important system changes."
	| oldClass newClass organization instVars classVars force needNew oldCategory copyOfOldClass newCategory |
	instVars _ Smalltalk actualScannerClass new scanFieldNames: instVarString.
	classVars _ (Smalltalk actualScannerClass new scanFieldNames: classVarString) collect: [:x | x asSymbol].

	"Validate the proposed name"
	unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]].
	oldClass _ Smalltalk at: className ifAbsent:[nil].
	oldClass isBehavior 
		ifFalse:[oldClass _ nil]. "Already checked in #validateClassName:"
	copyOfOldClass _ oldClass copy.

	unsafe ifFalse:[
		"Run validation checks so we know that we have a good chance for recompilation"
		(self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil].
		(self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
		(self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
		(self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]].

	"See if we need a new subclass"
	needNew _ self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass.
	needNew ifNil: [^nil]. "some error"

	(needNew and:[unsafe not]) ifTrue:[
		"Make sure we don't redefine any dangerous classes"
		(self tooDangerousClasses includes: oldClass name) ifTrue:[
			self error: oldClass name, ' cannot be changed'.
		].
		"Check if the receiver should not be redefined"
		(oldClass notNil and:[oldClass shouldNotBeRedefined]) ifTrue:[
			self notify: oldClass name asText allBold, 
						' should not be redefined!! \Proceed to store over it.' withCRs]].

	needNew ifTrue:[
		"Create the new class"
		newClass _ self 
			newSubclassOf: newSuper 
			type: type 
			instanceVariables: instVars
			from: oldClass.
		newClass ifNil: [ ^nil]. "Some error"
		newClass setName: className.
	] ifFalse:[
		"Reuse the old class"
		newClass _ oldClass.
	].

	"Install the class variables and pool dictionaries... "
	force _ (newClass declare: classVarString) | (newClass sharing: poolString).

	"... classify ..."
	newCategory _ category asSymbol.
	organization _ Smalltalk organization.
	oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol].
	organization classify: newClass name under: newCategory.

	"... recompile ..."
	newClass _ self recompile: force from: oldClass to: newClass mutate: false.

	"... export if not yet done ..."
	(Smalltalk at: newClass name ifAbsent:[nil]) == newClass ifFalse:[
		[Smalltalk at: newClass name put: newClass]
			on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true].
		Smalltalk flushClassNameCache.
	].

	self doneCompiling: newClass.
	
	"... notify interested clients ..."
	oldClass isNil ifTrue: [
		SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory.
		^ newClass].
	SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.
	newCategory ~= oldCategory 
		ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category].
	^newClass! !

!ClassBuilder methodsFor: 'validation' stamp: 'jmv 3/1/2010 14:02'!
validateSuperclass: aSuperClass forSubclass: aClass
	"Check if it is okay to use aSuperClass as the superclass of aClass"
	aClass ifNil: [ "New class"
		(aSuperClass == nil or:[aSuperClass isBehavior and:[aSuperClass isMeta not]])
			ifFalse:[self error: aSuperClass name,' is not a valid superclass'.
					^false].
		^true].
	aSuperClass == aClass superclass ifTrue:[^true]. "No change"
	(aClass isMeta) "Not permitted - meta class hierarchy is derived from class hierarchy"
		ifTrue:[^self error: aClass name, ' must inherit from ', aClass superclass name].
	"Check for circular references"
	(aSuperClass notNil and:[aSuperClass == aClass or:[aSuperClass inheritsFrom: aClass]])
		ifTrue:[self error: aSuperClass name,' inherits from ', aClass name.
				^false].
	^true! !


!ClassChangeRecord methodsFor: 'all changes' stamp: 'jmv 3/1/2010 14:02'!
allChangeTypes

	| chgs |
	(priorName notNil and: [changeTypes includes: #rename]) ifTrue:
		[(chgs _ changeTypes copy) add: 'oldName: ' , priorName.
		^ chgs].
	^ changeTypes! !


!ClassDescription methodsFor: 'fileIn/Out' stamp: 'jmv 3/1/2010 14:03'!
printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
	"Print a method category preamble.  This must have a category name.
	It may have an author/date stamp, and it may have a prior source link.
	If it has a prior source link, it MUST have a stamp, even if it is empty."

"The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."

	aFileStream cr; nextPut: $!!.
	aFileStream nextChunkPut: (String streamContents:
		[:strm |
		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
		(changeStamp notNil and: [
			changeStamp size > 0 or: [priorMethod notNil]]) ifTrue: [
			strm nextPutAll: ' stamp: '; print: changeStamp].
		priorMethod notNil ifTrue: [
			strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).! !


!CodeHolder methodsFor: 'categories' stamp: 'jmv 3/1/2010 14:03'!
letUserReclassify: anElement in: aClass
	"Put up a list of categories and solicit one from the user.  
	Answer true if user indeed made a change, else false"
	

	| currentCat newCat |
	currentCat _ aClass organization categoryOfElement: anElement.
	newCat _ self 
				categoryFromUserWithPrompt: 'choose category (currently "', currentCat, '")' 
				for: aClass.
	(newCat notNil and: [newCat ~= currentCat])
		ifTrue:
			[aClass organization classify: anElement under: newCat suppressIfDefault: false.
			^ true]
		ifFalse:
			[^ false]! !


!Browser methodsFor: 'class functions' stamp: 'jmv 3/1/2010 14:01'!
explainSpecial: string 
	"Answer a string explaining the code pane selection if it is displaying 
	one of the special edit functions."

	| classes whole lits reply |
	(editSelection == #editClass or: [editSelection == #newClass])
		ifTrue: 
			["Selector parts in class definition"
			string last == $: ifFalse: [^nil].
			lits _ Array with:
				#subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:.
			(whole _ lits detect: [:each | (each keywords
					detect: [:frag | frag = string] ifNone: []) notNil]
						ifNone: []) notNil
				ifTrue: [reply _ '"' , string , ' is one part of the message selector ' , whole , '.']
				ifFalse: [^nil].
			classes _ Smalltalk allClassesImplementing: whole.
			classes _ 'these classes ' , classes printString.
			^reply , '  It is defined in ' , classes , '."
Smalltalk browseAllImplementorsOf: #' , whole].

	editSelection == #hierarchy
		ifTrue: 
			["Instance variables in subclasses"
			classes _ self selectedClassOrMetaClass allSubclasses.
			classes _ classes detect: [:each | (each instVarNames
						detect: [:name | name = string] ifNone: []) notNil]
					ifNone: [^nil].
			classes _ classes printString.
			^'"is an instance variable in class ' , classes , '."
' , classes , ' browseAllAccessesTo: ''' , string , '''.'].
	editSelection == #editSystemCategories ifTrue: [^nil].
	editSelection == #editMessageCategories ifTrue: [^nil].
	^nil! !

!Browser methodsFor: 'message functions' stamp: 'jmv 3/1/2010 14:01'!
inspectInstances
	"Inspect all instances of the selected class.  1/26/96 sw"

	| myClass |
	myClass _ self selectedClassOrMetaClass.
	myClass notNil ifTrue: [
		myClass theNonMetaClass inspectAllInstances].
! !

!Browser methodsFor: 'message functions' stamp: 'jmv 3/1/2010 14:01'!
inspectSubInstances
	"Inspect all instances of the selected class and all its subclasses  1/26/96 sw"

	| aClass |
	aClass _ self selectedClassOrMetaClass.
	aClass notNil ifTrue: [
		aClass _ aClass theNonMetaClass.
		 aClass inspectSubInstances].
! !


!Compiler methodsFor: 'private' stamp: 'jmv 3/1/2010 14:05'!
interactive
	"this version of the method is necessary to load code from MC else the interactive mode is one. 
	This method is really bad since it links the compiler package with the Tools
	one. The solution would be to have a real SyntaxError exception belonging to the 
	compiler package and not a subclass of StringHolder - sd Nov 2005"
	"the code submitted by PlusTools is ideally the one that should be used
	interactive

	      ^requestor ~~ nil "

	^ requestor notNil and: [(requestor isKindOf: SyntaxError) not]! !


!ContextPart methodsFor: 'debugger access' stamp: 'jmv 3/1/2010 14:04'!
stackOfSize: limit 
	"Answer an OrderedCollection of the top 'limit' contexts
	 on the receiver's sender chain."

	| stack ctxt |
	stack := OrderedCollection new.
	stack addLast: (ctxt := self).
	[(ctxt := ctxt sender) notNil
	 and: [stack size < limit]] whileTrue:
		[stack addLast: ctxt].
	^stack! !


!BlockContext methodsFor: 'private' stamp: 'jmv 3/1/2010 13:59'!
hideFromDebugger

	^home notNil and: [home hideFromDebugger]! !


!Encoder methodsFor: 'initialize-release' stamp: 'jmv 3/1/2010 14:04'!
init: aClass context: aContext notifying: req
	requestor := req.
	class := aClass.
	nTemps := 0.
	supered := false.
	self initScopeAndLiteralTables.
	class variablesAndOffsetsDo: [ :variable "<String>" :offset "<Integer>" |
		scopeTable
			at: variable
			put: (offset >= 0
					ifTrue: [InstanceVariableNode new
								name: variable index: offset]
					ifFalse: [MaybeContextInstanceVariableNode new
								name: variable index: offset negated])].
	aContext notNil ifTrue: [
		| homeNode |
		 homeNode := self bindTemp: self doItInContextName.
		 "0th temp = aContext passed as arg"
		 aContext tempNames withIndexDo:
			[:variable :index|
			scopeTable
				at: variable
				put: (MessageAsTempNode new
						receiver: homeNode
						selector: #namedTempAt:
						arguments: (Array with: (self encodeLiteral: index))
						precedence: 3
						from: self)]].
	sourceRanges := Dictionary new: 32.
	globalSourceRanges := OrderedCollection new: 32! !


!Envelope methodsFor: 'applying' stamp: 'jmv 3/1/2010 14:04'!
computeValueAtMSecs: mSecs
	"Return the value of this envelope at the given number of milliseconds from its onset. Return zero for times outside the time range of this envelope."
	"Note: Unlike the private method incrementalComputeValueAtMSecs:, this method does is not increment. Thus it is slower, but it doesn't depend on being called sequentially at fixed time intervals."

	| t i |
	mSecs < 0 ifTrue: [^ 0.0].

	(loopEndMSecs notNil and: [mSecs >= loopEndMSecs]) ifTrue: [  "decay phase"
		t _ (points at: loopEndIndex) x + (mSecs - loopEndMSecs).
		i _ self indexOfPointAfterMSecs: t startingAt: loopEndIndex.
		i ifNil: [^ 0.0].  "past end"
		^ (self interpolate: t between: (points at: i - 1) and: (points at: i)) * decayScale].

	mSecs < loopStartMSecs ifTrue: [  "attack phase"
		i _ self indexOfPointAfterMSecs: mSecs startingAt: 1.
		i = 1 ifTrue: [^ (points at: 1) y * scale].
		^ self interpolate: mSecs between: (points at: i - 1) and: (points at: i)].

	"sustain phase"
	loopMSecs = 0 ifTrue: [^ (points at: loopEndIndex) y * scale].  "looping on a single point"
	t _ loopStartMSecs + ((mSecs - loopStartMSecs) \\ loopMSecs).
	i _ self indexOfPointAfterMSecs: t startingAt: loopStartIndex.

	^ self interpolate: t between: (points at: i - 1) and: (points at: i)
! !

!Envelope methodsFor: 'private' stamp: 'jmv 3/1/2010 14:05'!
incrementalComputeValueAtMSecs: mSecs
	"Compute the current value, per-step increment, and the time of the next inflection point."
	"Note: This method is part of faster, but less general, way of computing envelope values. It depends on a known, fixed control updating rate."

	| t i |
	(loopEndMSecs notNil and: [mSecs >= loopEndMSecs]) ifTrue: [  "decay phase"
		t _ (points at: loopEndIndex) x + (mSecs - loopEndMSecs).
		i _ self indexOfPointAfterMSecs: t startingAt: loopEndIndex.
		i ifNil: [  "past end"
			currValue _ points last y * scale * decayScale.
			valueIncr _ 0.0.
			nextRecomputeTime _ mSecs + 1000000.
			^ currValue].
		nextRecomputeTime _ mSecs + ((points at: i) x - t).
		^ self computeIncrementAt: t
			between: (points at: i - 1)
			and: (points at: i)
			scale: scale * decayScale].

	mSecs < loopStartMSecs
		ifTrue: [  "attack phase"
			t _ mSecs.
			i _ self indexOfPointAfterMSecs: t startingAt: 1.
			nextRecomputeTime _ mSecs + ((points at: i) x - t)]
		ifFalse: [  "sustain (looping) phase"
			noChangesDuringLoop ifTrue: [
				currValue _ (points at: loopEndIndex) y * scale.
				valueIncr _ 0.0.
					loopEndMSecs
						ifNil: [nextRecomputeTime _ mSecs + 10]	 "unknown end time"
						ifNotNil: [nextRecomputeTime _ loopEndMSecs].
				^ currValue].
			t _ loopStartMSecs + ((mSecs - loopStartMSecs) \\ loopMSecs).
			i _ self indexOfPointAfterMSecs: t startingAt: loopStartIndex.
			nextRecomputeTime _ (mSecs + ((points at: i) x - t)) min: loopEndMSecs].

	^ self computeIncrementAt: t
		between: (points at: i - 1)
		and: (points at: i)
		scale: scale.
! !


!FileDirectory methodsFor: 'file operations' stamp: 'jmv 3/1/2010 14:05'!
rename: oldFileName toBe: newFileName
	| selection oldName newName |
	"Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name."
	"Modified for retry after GC ar 3/21/98 18:09"
	oldName _ self fullNameFor: oldFileName.
	newName _ self fullNameFor: newFileName.
	(StandardFileStream 
		retryWithGC:[self primRename: oldName to: newName]
		until:[:result| result notNil]
		forFileNamed: oldName) notNil ifTrue:[^self].
	(self fileExists: oldFileName) ifFalse:[
		^self error:'Attempt to rename a non-existent file'.
	].
	(self fileExists: newFileName) ifTrue:[
		selection _ (PopUpMenu labels:
'delete old version
cancel')
				startUpWithCaption: 'Trying to rename a file to be
', newFileName , '
and it already exists.'.
		selection = 1 ifTrue:
			[self deleteFileNamed: newFileName.
			^ self rename: oldFileName toBe: newFileName]].
	^self error:'Failed to rename file'.! !


!Form class methodsFor: 'instance creation' stamp: 'jmv 3/1/2010 14:05'!
fromDisplay: aRectangle using: oldForm
	"Like fromDisplay: only if oldForm is the right size, copy into it and answer it instead."

	(oldForm notNil and: [oldForm extent = aRectangle extent])
		ifTrue:
			[oldForm fromDisplay: aRectangle.
			 ^ oldForm]
		ifFalse:
			[^ self fromDisplay: aRectangle]! !


!ColorForm class methodsFor: 'as yet unclassified' stamp: 'jmv 3/1/2010 14:03'!
twoToneFromDisplay: aRectangle using: oldForm backgroundColor: bgColor
	"Return a 1-bit deep ColorForm copied from the given rectangle of the display. All colors except the background color will be mapped to black."

	| f |
	(oldForm notNil and: [oldForm extent = aRectangle extent]) ifTrue: [
		f _ oldForm fromDisplay: aRectangle.
	] ifFalse: [
		f _ ColorForm extent: aRectangle extent depth: 1.
		f twoToneFromDisplay: aRectangle backgroundColor: bgColor.
		f colors: (Array
			with: bgColor
			with: Color black)].
	^ f
! !


!MIDIFileReader methodsFor: 'private' stamp: 'jmv 3/1/2010 14:05'!
scanForMIDIHeader
	"Scan the first part of this file in search of the MIDI header string 'MThd'. Report an error if it is not found. Otherwise, leave the input stream positioned to the first byte after this string."

	| asciiM p lastSearchPosition byte restOfHeader |
	asciiM _ $M asciiValue.
	stream skip: -3.
	p _ stream position.
	lastSearchPosition _ p + 10000.  "search only the first 10000 bytes of the file"
	[p < lastSearchPosition and: [stream atEnd not]] whileTrue: [
		[(byte _ stream next) ~= asciiM and: [byte notNil]] whileTrue.  "find the next 'M' or file end"
		restOfHeader _ (stream next: 3) asString.
		restOfHeader = 'Thd'
			ifTrue: [^ self]
			ifFalse: [restOfHeader size = 3 ifTrue: [stream skip: -3]].
		p _ stream position].

	self error: 'MIDI header chunk not found'.
! !


!MessageNode methodsFor: 'code generation' stamp: 'jmv 3/1/2010 14:05'!
emitForValue: stack on: strm
	"For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly."
	special > 0
		ifTrue: 
			[pc := 0.
			self perform: (MacroEmitters at: special) with: stack with: strm with: true]
		ifFalse: 
			[receiver notNil ifTrue: [receiver emitForValue: stack on: strm].
			arguments do: [:argument | argument emitForValue: stack on: strm].
			pc := strm position + 1. "debug pc is first byte of the send, i.e. the next byte".
			selector
				emit: stack
				args: arguments size
				on: strm
				super: receiver == NodeSuper]! !

!MessageNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:05'!
emitCodeForValue: stack encoder: encoder
	"For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly."
	special > 0
		ifTrue: 
			[pc := 0.
			self perform: (NewStyleMacroEmitters at: special) with: stack with: encoder with: true]
		ifFalse: 
			[receiver notNil ifTrue: [receiver emitCodeForValue: stack encoder: encoder].
			arguments do: [:argument | argument emitCodeForValue: stack encoder: encoder].
			pc := encoder methodStreamPosition + 1. "debug pc is first byte of the send, i.e. the next byte".
			selector
				emitCode: stack
				args: arguments size
				encoder: encoder
				super: receiver == NodeSuper]! !


!MessageSet methodsFor: 'private' stamp: 'jmv 3/1/2010 14:05'!
contents: aString notifying: aController 
	"Compile the code in aString. Notify aController of any syntax errors. 
	Answer false if the compilation fails. Otherwise, if the compilation 
	created a new method, deselect the current selection. Then answer true."

	| category selector class oldSelector |
	self okayToAccept ifFalse: [^ false].
	self setClassAndSelectorIn: [:c :os | class _ c.  oldSelector _ os].
	class ifNil: [^ false].
	(oldSelector notNil and: [oldSelector first isUppercase]) ifTrue:
		[oldSelector = #Comment ifTrue:
			[class comment: aString stamp: Utilities changeStamp.
			self changed: #annotation.
 			self clearUserEditFlag.
			^ false].
		oldSelector = #Definition ifTrue:
			["self defineClass: aString notifying: aController."
			class subclassDefinerClass
				evaluate: aString
				notifying: aController
				logged: true.
			self clearUserEditFlag.
 			^ false].
		oldSelector = #Hierarchy ifTrue:
			[self inform: 'To change the hierarchy, edit the class definitions'. 
			^ false]].
	"Normal method accept"
	category _ class organization categoryOfElement: oldSelector.
	selector _ class compile: aString
				classified: category
				notifying: aController.
	selector
		ifNil: [^ false].
	selector == oldSelector ifFalse:
		[self reformulateListNoting: selector].
	contents _ aString copy.
	self changed: #annotation.
	^ true! !


!MethodContext methodsFor: 'private-debugger' stamp: 'jmv 3/1/2010 14:16'!
hideFromDebugger

	| sndr sndrHome |
	^self cachesStack
		or: [(sndr := self sender) notNil
			and: [(sndrHome := sndr home) notNil
				and: [sndrHome cachesStack]]]! !


!Parser methodsFor: 'private' stamp: 'jmv 3/1/2010 14:05'!
addComment

	parseNode notNil
		ifTrue: 
			[parseNode comment: currentComment.
			currentComment := nil]! !

!Parser methodsFor: 'error handling' stamp: 'jmv 3/1/2010 14:06'!
interactive
	"this version of the method is necessary to load code from MC else the interactive mode is one. 
	This method is really bad since it links the compiler package with the Tools
	one. The solution would be to have a real SyntaxError exception belonging to the 
	compiler package and not a subclass of StringHolder - sd Nov 2005"
	"the code submitted by PlusTools is ideally the one that should be used
	interactive

	      ^requestor ~~ nil "

	^ requestor notNil and: [(requestor isKindOf: SyntaxError) not]! !


!ScorePlayer methodsFor: 'sound generation' stamp: 'jmv 3/1/2010 14:06'!
processNoteEventsAtTick: scoreTick
	"Process note events through the given score tick using internal Squeak sound synthesis."

	| instr j evt snd |
	1 to: score tracks size do: [:i |
		instr _ instruments at: i.
		j _ trackEventIndex at: i.
		[
			evt _ score eventForTrack: i after: j ticks: scoreTick.
			evt notNil
		] whileTrue: [
			(evt isNoteEvent and: [(muted at: i) not]) ifTrue: [
				snd _ instr
					soundForMidiKey: evt midiKey
					dur: secsPerTick * evt duration
					loudness: evt velocity asFloat / 127.0.
				activeSounds add: (Array with: snd with: i)].
			j _ j + 1.
			trackEventIndex at: i put: j]].
! !

!ScorePlayer methodsFor: 'midi output' stamp: 'jmv 3/1/2010 14:06'!
processMIDIEventsAtTick: scoreTick
	"Process note events through the given score tick using MIDI."

	| j evt |
	1 to: score tracks size do: [:i |
		j _ trackEventIndex at: i.
		[
			evt _ score eventForTrack: i after: j ticks: scoreTick.
			 evt notNil
		] whileTrue: [
			evt isNoteEvent
				ifTrue: [
					(muted at: i) ifFalse: [
						evt startNoteOnMidiPort: midiPort.
						activeMIDINotes add: (Array with: evt with: i)]]
				ifFalse: [evt outputOnMidiPort: midiPort].
			j _ j + 1.
			trackEventIndex at: i put: j]].
	self turnOffActiveMIDINotesAt: scoreTick.
! !


!Set methodsFor: 'testing' stamp: 'jmv 3/1/2010 14:06'!
includes: anObject 
	^ (array at: (self findElementOrNil: anObject)) notNil! !


!SoundPlayer class methodsFor: 'player process' stamp: 'jmv 3/1/2010 14:07'!
isReverbOn

	^ ReverbState notNil
! !


!SoundRecorder methodsFor: 'recording controls' stamp: 'jmv 3/1/2010 14:07'!
pause
	"Go into pause mode. The record level continues to be updated, but no sound is recorded."

	paused _ true.
	(currentBuffer notNil and: [nextIndex > 1])
		ifTrue: [
			self emitPartialBuffer.
			self allocateBuffer].

	soundPlaying ifNotNil: [
		soundPlaying pause.
		soundPlaying _ nil].
	"Note: there can be problems if canRecordWhilePlaying is true. Recorders which only pause will inhibit other recorders from recording. I chose to make #stopPlaying unconditional in a subclass. The same might be appropriate here at the expense of making recorders resumable"

	Preferences canRecordWhilePlaying ifFalse: [self stopRecording].
! !

!SoundRecorder methodsFor: 'recording controls' stamp: 'jmv 3/1/2010 14:08'!
stopRecording
	"Stop the recording process and turn of the sound input driver."

	recordProcess ifNotNil: [recordProcess terminate].
	recordProcess _ nil.
	self primStopRecording.
	RecorderActive _ false.
	Smalltalk unregisterExternalObject: bufferAvailableSema.
	(currentBuffer notNil and: [nextIndex > 1])
		ifTrue: [self emitPartialBuffer].
	self initializeRecordingState.
! !


!SoundInputStream methodsFor: 'accessing' stamp: 'jmv 3/1/2010 14:07'!
isRecording
	"Answer true if the sound input process is running."

	^ recordProcess notNil
! !


!String methodsFor: 'converting' stamp: 'jmv 3/1/2010 14:08'!
substrings
	"Answer an array of the substrings that compose the receiver."
	| result end beginning |

	result _ WriteStream on: (Array new: 10).



	end _ 0.
	"find one substring each time through this loop"
	[ 
		"find the beginning of the next substring"
		beginning _ self indexOfAnyOf: CSNonSeparators startingAt: end+1 ifAbsent: [ nil ].
		beginning notNil ] 
	whileTrue: [
		"find the end"
		end _ self indexOfAnyOf: CSSeparators startingAt: beginning ifAbsent: [ self size + 1 ].
		end _ end - 1.

		result nextPut: (self copyFrom: beginning to: end).

	].


	^result contents! !


!SystemDictionary methodsFor: 'housekeeping' stamp: 'jmv 3/1/2010 14:08'!
obsoleteClasses   "Smalltalk obsoleteClasses inspect"
	"NOTE:  Also try inspecting comments below"
	| obs c |
	obs _ OrderedCollection new.  Smalltalk garbageCollect.
	Metaclass allInstancesDo:
		[:m | c _ m soleInstance.
		(c notNil and: ['AnOb*' match: c name asString])
			ifTrue: [obs add: c]].
	^ obs asArray

"Likely in a ClassDict or Pool...
(Association allInstances select: [:a | (a value isKindOf: Class) and: ['AnOb*' match: a value name]]) asArray
"
"Obsolete class refs or super pointer in last lit of a method...
| n l found |
Smalltalk browseAllSelect:
	[:m | found _ false.
	1 to: m numLiterals do:
		[:i | (((l _ m literalAt: i) isMemberOf: Association)
				and: [(l value isKindOf: Behavior)
				and: ['AnOb*' match: l value name]])
			ifTrue: [found _ true]].
	found]
"! !


!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'jmv 3/1/2010 14:17'!
isReferencedWithinBlockExtent: anInterval 
	readingScopes notNil ifTrue:
		[readingScopes do:
			[:set "<Set of <Integer>>"|
			set do:
				[:location|
				 (anInterval rangeIncludes: location) ifTrue:
					[^true]]]].
	writingScopes notNil ifTrue:
		[writingScopes do:
			[:set "<Set of <Integer>>"|
			set do:
				[:location|
				 (anInterval rangeIncludes: location) ifTrue:
					[^true]]]].
	^false! !

!TempVariableNode methodsFor: 'code generation (closures)' stamp: 'jmv 3/1/2010 14:17'!
referenceScopesAndIndicesDo: aBinaryBlock
	"Evaluate aBinaryBlock with all read or write scopes and locations.
	 This is used to copy the reference information into RemoteTempVectorNodes"
	readingScopes notNil ifTrue:
		[readingScopes keysAndValuesDo:
			[:scopeBlock "<BlockNode>" :set "<Set of <Integer>>"|
			set do: [:location| aBinaryBlock value: scopeBlock value: location]]].
	writingScopes notNil ifTrue:
		[writingScopes keysAndValuesDo:
			[:scopeBlock "<BlockNode>" :set "<Set of <Integer>>"|
			set do: [:location| aBinaryBlock value: scopeBlock value: location]]]! !

!TempVariableNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:08'!
emitCodeForLoad: stack encoder: encoder
	remoteNode notNil ifTrue: [
		remoteNode emitCodeForLoadFor: self stack: stack encoder: encoder]! !

!TempVariableNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:08'!
emitCodeForStore: stack encoder: encoder
	remoteNode notNil ifTrue: [
		^remoteNode emitCodeForStoreInto: self stack: stack encoder: encoder].
	encoder genStoreTemp: index! !

!TempVariableNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:08'!
emitCodeForStorePop: stack encoder: encoder
	remoteNode notNil ifTrue: [
		^remoteNode emitCodeForStorePopInto: self stack: stack encoder: encoder].
	encoder genStorePopTemp: index.
	stack pop: 1! !

!TempVariableNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:08'!
emitCodeForValue: stack encoder: encoder
	remoteNode notNil ifTrue: [
		^remoteNode emitCodeForValueOf: self stack: stack encoder: encoder].
	encoder genPushTemp: index.
	stack push: 1! !

!TempVariableNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:16'!
sizeCodeForStore: encoder
	remoteNode notNil ifTrue:
		[^remoteNode sizeCodeForStoreInto: self encoder: encoder].
	self reserve: encoder.
	^encoder sizeStoreTemp: index! !

!TempVariableNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:17'!
sizeCodeForStorePop: encoder
	remoteNode notNil ifTrue:
		[^remoteNode sizeCodeForStorePopInto: self encoder: encoder].
	self reserve: encoder.
	^encoder sizeStorePopTemp: index! !

!TempVariableNode methodsFor: 'code generation (new scheme)' stamp: 'jmv 3/1/2010 14:17'!
sizeCodeForValue: encoder
	remoteNode notNil ifTrue:
		[^remoteNode sizeCodeForValueOf: self encoder: encoder].
	self reserve: encoder.
	^encoder sizePushTemp: index! !


!TextEditor methodsFor: 'accessing' stamp: 'jmv 3/1/2010 14:17'!
replaceSelectionWith: aText
	"Remember the selection text in UndoSelection.
	 Deselect, and replace the selection text by aText.
	 Remember the resulting selectionInterval in UndoInterval and PriorInterval.
	 Set up undo to use UndoReplace."

	beginTypeInBlock notNil ifTrue: [^self zapSelectionWith: aText]. "called from old code"
	UndoSelection _ self selection.
	self zapSelectionWith: aText.
	self undoer: #undoReplace! !


!SmalltalkEditor methodsFor: 'explain' stamp: 'jmv 3/1/2010 14:16'!
explainClass: symbol 
	"Is symbol a class variable or a pool variable?"
	| class reply classes |
	(model respondsTo: #selectedClassOrMetaClass)
		ifFalse: [^ nil].
	(class _ model selectedClassOrMetaClass) ifNil: [^ nil].
	"no class is selected"
	(class isKindOf: Metaclass)
		ifTrue: [class _ class soleInstance].
	classes _ (Array with: class)
				, class allSuperclasses.
	"class variables"
	reply _ classes detect: [:each | (each classVarNames detect: [:name | symbol = name]
					ifNone: [])
					notNil]
				ifNone: [].
	reply ifNotNil: [
		^ '"is a class variable, defined in class ' , reply printString , '"\' withCRs , 
		'SystemNavigation new browseAllCallsOn: (' , reply printString , ' classPool associationAt: #' , symbol , ').'].
	"pool variables"
	classes do: [:each | (each sharedPools
			detect: [:pool | (pool includesKey: symbol)
					and: 
						[reply _ pool.
						true]]
			ifNone: [])
			notNil].
	reply
		ifNil: [(Undeclared includesKey: symbol)
				ifTrue: [
					^ '"is an undeclared variable.' , '"\' withCRs , 
					'SystemNavigation new browseAllCallsOn: (Undeclared associationAt: #' , symbol , ').']]
		ifNotNil: 
			[classes _ WriteStream on: Array new.
			Smalltalk
				allBehaviorsDo: [:each | (each sharedPools
						detect: 
							[:pool | 
							pool == reply]
						ifNone: [])
						notNil ifTrue: [classes nextPut: each]].
			"Perhaps not print whole list of classes if too long. (unlikely)"
			^ '"is a pool variable from the pool ' , (Smalltalk keyAtIdentityValue: reply) asString , 
			', which is used by the following classes ' , classes contents printString , '"\' withCRs , 
			'SystemNavigation new browseAllCallsOn: (' , (Smalltalk keyAtIdentityValue: reply) asString , 
			' bindingOf: #' , symbol , ').'].
	^ nil! !

!SmalltalkEditor methodsFor: 'explain' stamp: 'jmv 3/1/2010 14:07'!
explainGlobal: symbol 
	"Is symbol a global variable?"
	| reply classes |
	reply _ Smalltalk at: symbol ifAbsent: [^nil].
	(reply class == Dictionary or:[reply isKindOf: SharedPool class])
		ifTrue: 
			[classes _ Set new.
			Smalltalk allBehaviorsDo: [:each | (each sharedPools detect: [:pool | pool == reply]
					ifNone: [])
					notNil ifTrue: [classes add: each]].
			classes _ classes printString.
			^'"is a global variable.  It is a pool which is used by the following classes ' , (classes allButFirst: 5) , '"'].
	(reply isKindOf: Behavior)
		ifTrue: [^'"is a global variable.  ' , symbol , ' is a class in category ', reply category,
			'."', '\' withCRs, 'Browser newOnClass: ' , symbol , '.'].
	symbol == #Smalltalk ifTrue: [^'"is a global.  Smalltalk is the only instance of SystemDictionary and holds all global variables."'].
	^'"is a global variable.  ' , symbol , ' is ' , reply printString , '"'! !

!SmalltalkEditor methodsFor: 'explain' stamp: 'jmv 3/1/2010 14:07'!
explainInst: string 
	"Is string an instance variable of this class?"
	| classes cls |

	(model respondsTo: #selectedClassOrMetaClass) ifTrue: [
		cls _ model selectedClassOrMetaClass].
	cls ifNil: [^ nil].	  "no class known"
	classes _ (Array with: cls)
				, cls allSuperclasses.
	classes _ classes detect: [:each | (each instVarNames
			detect: [:name | name = string] ifNone: [])
			notNil] ifNone: [^nil].
	classes _ classes printString.
	^ '"is an instance variable of the receiver; defined in class ' , classes , 
		'"\' withCRs , classes , ' systemNavigation browseAllAccessesTo: ''' , string , ''' from: ', classes, '.'! !

!SmalltalkEditor methodsFor: 'explain' stamp: 'jmv 3/1/2010 14:07'!
explainPartSel: string 
	"Is this a fragment of a multiple-argument selector sent in this method?"
	| lits whole reply classes s msg |

	(model respondsTo: #selectedMessageName) ifFalse: [^ nil].
	(msg _ model selectedMessageName) ifNil: [^ nil].  "not in a message"
	string last == $: ifFalse: [^ nil].
	"Name of this method"
	lits _ Array with: msg.
	(whole _ lits detect: [:each | (each keywords detect: [:frag | frag = string]
					ifNone: []) notNil]
				ifNone: []) notNil
		ifTrue: [reply _ ', which is the selector of this very method!!'.
			s _ '.  To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']
		ifFalse: 
			["Selectors called from this method"
			lits _ (model selectedClassOrMetaClass compiledMethodAt:
				msg) messages.
			(whole _ lits detect: [:each | (each keywords detect: [:frag | frag = string]
							ifNone: []) notNil]
						ifNone: []) notNil
				ifFalse: [string = 'primitive:'
					ifTrue: [^self explainChar: '<']
					ifFalse: [^nil]].
			reply _ '.'.
			s _ '.  To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].
	classes _ Smalltalk allClassesImplementing: whole.
	classes size > 12
		ifTrue: [classes _ 'many classes']
		ifFalse: [classes _ 'these classes ' , classes printString].
	^ '"' , string , ' is one part of the message selector ' , whole, reply , '  It is defined in ' , classes , s! !

!SmalltalkEditor methodsFor: 'private' stamp: 'jmv 3/1/2010 14:16'!
completeSymbol: hintText lastOffering: selectorOrNil
	"Invoked by Ctrl-q when there is only a caret.
		Do selector-completion, i.e., try to replace the preceding identifier by a
		selector that begins with those characters & has as many keywords as possible.
	 	Leave two spaces after each colon (only one after the last) as space for
		arguments.  Put the caret after the space after the first keyword.  If the
		user types Ctrl-q again immediately, choose a different selector.
	 Undoer: #undoQuery:lastOffering:; Redoer: itself.
	If redoing, just redisplay the last offering, selector[OrNil]."

	| firstTime input prior caret newStart sym kwds outStream |
	firstTime _ self isRedoing
		ifTrue: [prior _ sym _ selectorOrNil. true]
		ifFalse: [hintText isNil].
	firstTime
		ifTrue: "Initial Ctrl-q (or redo)"					
			[caret _ self startIndex.
			self selectPrecedingIdentifier.
			input _ self selection]
		ifFalse: "Repeated Ctrl-q"
			[caret _ UndoInterval first + hintText size.
			self selectInvisiblyFrom: UndoInterval first to: UndoInterval last.
			input _ hintText.
			prior _ selectorOrNil].
	(input size ~= 0 and: [sym notNil or:
			[(sym _ Symbol thatStarts: input string skipping: prior) notNil]])
		ifTrue: "found something to offer"
			[newStart _ self startIndex.
			outStream _ WriteStream on: (String new: 2 * sym size).
			1 to: (kwds _ sym keywords) size do:
				[:i |
				outStream nextPutAll: (kwds at: i).
				i = 1 ifTrue: [caret _ newStart + outStream contents size + 1].
				outStream nextPutAll:
					(i < kwds size ifTrue: ['  '] ifFalse: [' '])].
			UndoSelection _ input.
			self deselect; zapSelectionWith: outStream contents asText.
			self undoer: #undoQuery:lastOffering: with: input with: sym]
		ifFalse: "no more matches"
			[firstTime ifFalse: "restore original text & set up for a redo"
				[UndoSelection _ self selection.
				self deselect; zapSelectionWith: input.
				self undoer: #completeSymbol:lastOffering: with: input with: prior.
				Undone _ true].
			morph flash].
	self selectAt: caret! !

!SmalltalkEditor methodsFor: 'private' stamp: 'jmv 3/1/2010 14:07'!
explainDelimitor: string
	"Is string enclosed in delimitors?"

	| str |
	(string at: 1) isLetter ifTrue: [^nil].  "only special chars"
	(string first = string last) ifTrue:
			[^ self explainChar: (String with: string first)]
		ifFalse:
			[(string first = $( and: [string last = $)]) ifTrue:
				[^ self explainChar: (String with: string first)].
			(string first = $[ and: [string last = $]]) ifTrue:
				[^ self explainChar: (String with: string first)].
			(string first = ${ and: [string last = $}]) ifTrue:
				[^ self explainChar: (String with: string first)].
			(string first = $< and: [string last = $>]) ifTrue:
				[^ self explainChar: (String with: string first)].
			(string first = $# and: [string last = $)]) ifTrue:
				[^'"An instance of class Array.  The Numbers, Characters, or Symbols between the parenthesis are the elements of the Array."'].
			string first = $# ifTrue:
				[^'"An instance of class Symbol."'].
			(string first = $$ and: [string size = 2]) ifTrue:
				[^'"An instance of class Character.  This one is the character ', (String with: string last), '."'].
			(string first = $:) ifTrue:
				[str := string allButFirst.
				(self explainTemp: str) notNil ifTrue: [
					^'"An argument to this block will be bound to the temporary variable ',
						str, '."']]].
	^ nil! !


!VolumeEnvelope methodsFor: 'as yet unclassified' stamp: 'jmv 3/1/2010 14:17'!
computeSlopeAtMSecs: mSecs
	"Private!! Find the next inflection point of this envelope and compute its target volume and the number of milliseconds until the inflection point is reached."

	| t i |
	((loopEndMSecs notNil) and: [mSecs >= loopEndMSecs]) ifTrue: [  "decay phase"
		t _ (points at: loopEndIndex) x + (mSecs - loopEndMSecs).
		i _ self indexOfPointAfterMSecs: t startingAt: loopEndIndex.
		i ifNil: [  "past end"
			targetVol _ points last y * decayScale.
			mSecsForChange _ 0.
			nextRecomputeTime _ mSecs + 1000000.
			^ self].
		targetVol _ (points at: i) y * decayScale.
		mSecsForChange _ (((points at: i) x - t) min: (endMSecs - mSecs)) max: 4.
		nextRecomputeTime _ mSecs + mSecsForChange.
		^ self].

	mSecs < loopStartMSecs ifTrue: [  "attack phase"
		i _ self indexOfPointAfterMSecs: mSecs startingAt: 1.
		targetVol _ (points at: i) y.
		mSecsForChange _ ((points at: i) x - mSecs) max: 4.
		nextRecomputeTime _ mSecs + mSecsForChange.
		((loopEndMSecs notNil) and: [nextRecomputeTime > loopEndMSecs])
			ifTrue: [nextRecomputeTime _ loopEndMSecs].
		^ self].

	"sustain and loop phase"
	noChangesDuringLoop ifTrue: [
		targetVol _ (points at: loopEndIndex) y.
		mSecsForChange _ 10.
		loopEndMSecs
			ifNil: [nextRecomputeTime _ mSecs + 10]  "unknown end time"
			ifNotNil: [nextRecomputeTime _ loopEndMSecs].
		^ self].

	loopMSecs = 0 ifTrue: [^ (points at: loopEndIndex) y].  "looping on a single point"
	t _ loopStartMSecs + ((mSecs - loopStartMSecs) \\ loopMSecs).
	i _ self indexOfPointAfterMSecs: t startingAt: loopStartIndex.
	targetVol _ (points at: i) y.
	mSecsForChange _ ((points at: i) x - t) max: 4.
	nextRecomputeTime _ (mSecs + mSecsForChange) min: loopEndMSecs.
! !

