sample[VSE] StReader

Code

"File: StReader.st
    __________________________________________________
    @Alejandro F. Reimondo 03/02/09
    This proyect sources are property of : Alejandro F. Reimondo
    Its use is NOT legal without written rights.
    Amenabar 3476 Piso: 2 Dto: B.
    Ciudad de Buenos Aires.
    Argentina.
    Tel: (54)-1-703-5586.
    __________________________________________________
"!

ARObject subclass: #StReader
  instanceVariableNames: 
    ' contents selectedClass mustEvaluate tag '
  classVariableNames: ''
  poolDictionaries: ''.

  (Smalltalk at: #StReader) comment: ' Development -
    Class for fileIn of changes...'   !


!StReader class methods !

fileIn
	"Lets the user select a file and perform fileIn on it...
	StReader fileIn.
	"

	| dialog file |
	dialog := FileDialog new.
	dialog
		addSmalltalkFileFilters;
		openFile.
	file := dialog file.
	file isNil ifTrue: [ ^nil ].
	^self fileIn: file!
  
fileIn: aStream
	" FileIn the contents of aStream into this image.
	 aStream can be a Stream or a fileName"

	| file result |
	(aStream isKindOf: Stream) ifTrue: [
		^self fileIn: aStream as: nil
	].

	(File exists: aStream) ifFalse: [^self error: 'File not found:',aStream].
	file := File pathName: aStream.
	[ result := self
		fileIn: file
		as: aStream fileName.
	] ensure: [ file close ].
	^result!
   
fileIn: aStream as: tag
	" FileIn the contents of aStream into this image. "

	^self new tag: tag; fileIn: aStream!
  
new
	" Returns an instance of the receiver. "

	^super new
		initialize;
		yourself! !



!StReader methods !
  
collectMethod: aCompiledMethod into: aCollection
	" Private - Scan a collection for a method similar to aCompiledMethod,
		if found replaces it by aCompiledMethod if not add it to the collection. "

	| mth |
	1 to: aCollection size do: [:index|
		mth := aCollection at: index.
		(mth selector == aCompiledMethod selector
		and: [ mth classField == aCompiledMethod classField ])
		ifTrue: [
			^aCollection at: index put: aCompiledMethod
		].
	].
	^aCollection add: aCompiledMethod!
  
collectMethod: aCompiledMethod into: aCollection as: sourceCode
	" Private - Scan a collection for a method similar to aCompiledMethod,
		if found replaces it by aCompiledMethod if not add it at end of aCollection. "

	aCompiledMethod sourceString: sourceCode.
	^self collectMethod: aCompiledMethod into: aCollection!
  
evaluate: aString
	" Private - Ask the user if the code in aString must be filled in... "

	(self mustEvaluateExpression: aString) ifTrue: [ Compiler evaluate: aString ]!
   
fileIn: aStream
	"File in the contents of aStream into this image..."

	| cursor toBeFiledIn chunk |
	cursor := Cursor.
	CursorManager execute change.
	[aStream atEnd or: [aStream peek isSeparator not ]] whileFalse: [aStream next].
	[aStream atEnd] whileFalse: [
			toBeFiledIn := aStream peekFor: $!!.
			chunk := aStream nextChunk.
			toBeFiledIn
				ifTrue: [ self fileIn: chunk from: aStream ]
				ifFalse: [ self evaluate: chunk ]
	].
	self performRealFileIn.
	CursorManager normal change.!
  
fileIn: aString from: aFile
	" Private - Scan aString for selected class and fileIn aFile contents upTo nul chunk... "

	| stream chunk answer old |
	self getClassFrom: aString.
	[(chunk := aFile nextChunk) isEmpty]	whileFalse: [
			answer := Compiler compile: chunk in: selectedClass.
			answer notNil ifTrue: [
				old := answer isNil ifTrue: [ "do nothing" ]
					ifFalse: [ selectedClass compiledMethodAt: answer key ].
				old isNil
				ifTrue: [ self collectMethod: answer value into: contents as: chunk ]
				ifFalse: [
					(self isSource: old sourceString equalTo: chunk)
					ifFalse: [ self collectMethod: answer value into: contents as: chunk ]
				]
			]
	].!
   
fileOutMethods: aCollection into: aStream
	" Private - FileOut the sources of aCollection of methods into aStream. "

	aCollection do: [:mth|
		aStream
			cr;cr;
			nextPut: $!!;
			nextPutAll: mth classField name;
			space;
			nextPutAll: 'methods !!';
			cr;
			nextChunkPut: mth sourceString;
			nextPutAll: ' !!'; cr
	].!
  
getClassFrom: aString
	" Private - Scan aString looking for selected class... "

	| stream words |
	stream := ReadStream on: aString trimBlanks.
	words := OrderedCollection new.
	[stream atEnd] whileFalse: [words add: stream nextWord].
	words last isNil ifTrue: [words removeLast].
	words last = 'methods' ifTrue: [ words removeLast ].
	selectedClass := Smalltalk at: words first asSymbol
		ifAbsent: [ ^self error: 'Class not found : ', words first ].
	words removeFirst.
	[words isEmpty] whileFalse: [
		selectedClass := selectedClass perform: words removeFirst asSymbol
	].
	^selectedClass!

initialize
	"Private - Initializes the receiver..."

	contents := OrderedCollection new: 500.!
   
isSource: aString equalTo: bString
	" Private - Returns true if both source strings are equal. "

	aString = bString ifTrue: [ ^true ].	
	^self isTabbed: aString equalTo: bString!
 
isTabbed: aString equalTo: bString
	" Private - Returns true if both source strings are equal skipping spaces/tabs. "

	| aStream bStream |
	aStream := ReadStream on: aString.
	bStream := ReadStream on: bString.
	[	aStream countBlanks. bStream countBlanks.
		aStream atEnd ] whileFalse: [
		aStream next = bStream next ifFalse: [ ^false ].
	].
	^bStream countBlanks; atEnd!
 
mustEvaluate
    "Returns the instance var of the receiver
     for external manipulation"
    ^mustEvaluate!

mustEvaluate: anObject
    "Sets the instance var of the receiver
     with anObject. (No checking is done)"
    mustEvaluate := anObject!
   
mustEvaluateExpression: expression
	" Returns true if the receiver must evaluate the expression. "

	| result |
	mustEvaluate isNil ifTrue: [
		result := MessageBox
			threeStateNotify: 'Parsing source...'
			withText: 'File in this code chunk ?\\' withCrs, expression asString.
		result isNil ifTrue: [ "cancel will set to always false"
			mustEvaluate := result := false.
		].
		^result
	].
	^mustEvaluate!
   
performRealFileIn
	" Private - Places the compiled code... "

	| replacedMethods newMethods old header |	
	replacedMethods := OrderedCollection new: contents size.
	newMethods := OrderedCollection new: contents size.
	contents do: [:each|
		old := each classField compiledMethodAt: each selector.
		old isNil
		ifTrue: [ newMethods add: each ]
		ifFalse: [ replacedMethods add: each ]
	].
	header := self tag isNil
		ifTrue: [ String new ]
		ifFalse: [ '[',self tag asString,'] ' ].
	self
		promptFileIn: newMethods as: header, 'New filledIn methods';
		promptFileIn: replacedMethods as: header, 'FilledIn patches & touched methods';
		yourself!
 
promptFileIn: aCollection as: aLabel
	" Private - Prompt for the collection to be filled in... "

	| stream |
	aCollection size = 0 ifTrue: [ ^self ].
	(MessageBox confirm: 'Perform fileIn of the ',aLabel,' ?')
	ifTrue: [
		aCollection do: [:each|
			each classField
				addSelector: each selector
				withMethod: each.
			 SourceManager current
				logSource: each sourceString
				forSelector: each selector
				inClass: each classField.
		].
		MethodBrowser new
			label: aLabel;
			openOn: aCollection asArray.
	]
	ifFalse: [
		stream := WriteStream on: (String new: 10000).
		self fileOutMethods: aCollection into: stream.
		TextWindow new
			label: aLabel , ' sources (not filledIn Yet...)';
			openOn: stream contents
	].!
 
tag
    "Returns the instance var of the receiver
     for external manipulation"
    ^tag!
  
tag: anObject
    "Sets the instance var of the receiver
     with anObject. (No checking is done)"
    tag := anObject!
 
trimBlanks: aString
	" Private - Returns aString with leading and trailing blanks removed. "

    | size start end |
    size := aString size.
    start := 1.
    [ start <= size and: [ ( aString at: start ) isSeparator ] ] whileTrue: [ start := start + 1 ].
    end := size.
    [ end >= 1 and: [ ( aString at: end ) isSeparator ] ] whileTrue: [ end := end - 1 ].
	(aString at: end) = $$ ifTrue: [ end := end + 1 min: size ].
    ^self copyFrom: start to: end! !