'From Cuis 2.3 of 22 March 2010 [latest update: #472] on 11 April 2010 at 10:30:25 pm'!
!classDefinition: #Workspace category: #'Kernel-ST80 Remnants'!
StringHolder subclass: #Workspace
	instanceVariableNames: 'bindings shouldStyle mustDeclareVariables '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Kernel-ST80 Remnants'!

!Dictionary methodsFor: 'testing' stamp: 'jmv 4/11/2010 22:00'!
hasBindingThatBeginsWith: aString
	"Answer true if the receiver has a key that begins with aString, false otherwise"
	
	self keysDo:[:each | 
		(each beginsWith: aString)
			ifTrue:[^true]].
	^false! !


!PluggableTextMorph methodsFor: 'accessing' stamp: 'jmv 4/11/2010 22:21'!
textMorph
	^ textMorph! !


!Preferences class methodsFor: 'shout' stamp: 'jmv 4/11/2010 21:53'!
shoutInWorkspaces
	^ self
		valueOfFlag: #shoutInWorkspaces
		ifAbsent: [true]! !


!SHParserST80 methodsFor: 'identifier testing' stamp: 'jmv 4/11/2010 22:07'!
resolvePartial: aString 
	"check if any identifier begins with aString"
	
	(#('self' 'super' 'true' 'false' 'nil' 'thisContext') anySatisfy: [:each | each beginsWith: aString]) 
		ifTrue: [^#incompleteIdentifier].
	(self isIncompleteBlockTempName: aString) ifTrue: [^#incompleteIdentifier].
	(self isIncompleteBlockArgName: aString) ifTrue: [^#incompleteIdentifier].
	(self isIncompleteMethodTempName: aString) ifTrue: [^#incompleteIdentifier].
	(self isIncompleteMethodArgName: aString) ifTrue: [^#incompleteIdentifier].
	(instanceVariables anySatisfy: [:each | each beginsWith: aString]) ifTrue: [^#incompleteIdentifier].
	workspace 
		ifNotNil: [(workspace hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
	classOrMetaClass isBehavior 
		ifTrue: [
			classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
				(c classPool hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier].
				c sharedPools do: [:p | ( p hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
				(Smalltalk hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]]
		ifFalse: [(Smalltalk hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
	^#undefinedIdentifier! !

!SHParserST80 methodsFor: 'identifier testing' stamp: 'jmv 4/11/2010 22:06'!
resolvePartialPragmaArgument: aString 
	"check if any valid pragma argument begins with aString"
	
	(#('true' 'false' 'nil') anySatisfy: [:each | each beginsWith: aString]) 
		ifTrue: [^#incompleteIdentifier].
	"should really check that a matching binding is for a Class?"
	classOrMetaClass isBehavior 
		ifTrue: [
			classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
				(Smalltalk hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]]
		ifFalse: [(Smalltalk hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
	^#undefinedIdentifier! !


!SharedPool class methodsFor: 'name lookup' stamp: 'nice 2/8/2010 09:43'!
bindingOf: varName
	"Answer the binding of some variable resolved in the scope of the receiver"
	| aSymbol binding |
	aSymbol := varName asSymbol.

	"First look in classVar dictionary."
	binding := self classPool bindingOf: aSymbol.
	binding ifNotNil:[^binding].

	"Next look in shared pools."
	self sharedPools do:[:pool | 
		| poolBinding |
		poolBinding := pool bindingOf: aSymbol.
		poolBinding ifNotNil:[^poolBinding].
	].

	"subclassing and environment are not preserved"
	^nil! !

!SharedPool class methodsFor: 'name lookup' stamp: 'tween 9/13/2004 10:10'!
hasBindingThatBeginsWith: aString
	"Answer true if the receiver has a binding that begins with aString, false otherwise"

	"First look in classVar dictionary."
	(self classPool hasBindingThatBeginsWith: aString) ifTrue:[^true].
	"Next look in shared pools."
	self sharedPools do:[:pool | 
		(pool hasBindingThatBeginsWith: aString) ifTrue: [^true]].
	^false! !

!SharedPool class methodsFor: 'enumerating' stamp: 'tpr 12/14/2004 12:34'!
keysDo: aBlock
"A hopefully temporary fix for an issue arising from miss-spelled variable names in code being compiled. The correction code (see Class>possibleVariablesFor:continuedFrom: assumes that sharedPools are Dictionaries. The proper fix would involve making sure all pools are actually subclasses of SharedPool, which they are not currently."
	self bindingsDo:[:b|
		aBlock value: b key]! !


!StringHolder methodsFor: 'services' stamp: 'jmv 4/11/2010 22:18'!
codeTextMorph
	^ self dependents
		detect: [:dep | (dep isKindOf: PluggableTextMorph)
				and: [dep getTextSelector == #contents]]
		ifNone: nil! !


!TextMorph methodsFor: 'accessing' stamp: 'jmv 4/11/2010 22:29'!
newContents: stringOrText 
	"Accept new text contents."
	| newText embeddedMorphs |
	"If my text is all the same font, use the font for my new contents"
	newText _ stringOrText isString ifTrue: [ | textSize |
		(text notNil
		  and: [ (textSize _ text size) > 0
		    and: [ (text runLengthFor: 1) = textSize ]]) ifTrue: [ | attribs |
			attribs _ text attributesAt: 1.
			Text initialStyle: text initialStyle string: stringOrText copy attributes: attribs.
		]
		ifFalse: [ Text fromString: stringOrText copy ]
	]
	ifFalse: [ stringOrText copy asText.	"should be veryDeepCopy?" ].

	(text = newText and: [ text runs = newText runs ]) ifTrue: [ ^ self ].
	text ifNotNil: [(embeddedMorphs _ text embeddedMorphs)
			ifNotNil: 
				[self removeAllMorphsIn: embeddedMorphs.
				embeddedMorphs do: [:m | m delete]]].

	text _ newText.

	"add all morphs off the visible region; they'll be moved into the right 
	place when they become visible. (this can make the scrollable area too 
	large, though)"
	newText embeddedMorphs do: 
		[:m | 
		self addMorph: m.
		m position: -1000 @ 0].
	self releaseParagraph.
	"update the paragraph cache"
	self paragraph.
	"re-instantiate to set bounds"
	self world ifNotNil: [self world startSteppingSubmorphsOf: self]! !


!Workspace methodsFor: 'initialize-release' stamp: 'jmv 4/11/2010 21:48'!
initialize
	
	super initialize.
	mustDeclareVariables := false! !

!Workspace methodsFor: 'binding' stamp: 'jmv 4/11/2010 21:48'!
bindingOf: aString
	mustDeclareVariables ifTrue: [^ nil].
	"I want to have workspace that force the user to declare  
	variables. Still subclasses may want to do something else"
	bindings
		ifNil: [ bindings _ Dictionary new].
	(bindings includesKey: aString)
		ifFalse: [bindings at: aString put: nil].
	^bindings associationAt: aString! !

!Workspace methodsFor: 'binding' stamp: 'jmv 4/11/2010 22:05'!
hasBindingThatBeginsWith: aString 
	
	bindings ifNil: [ ^false ].
	bindings keysDo: [ :each |
		(each beginsWith: aString) ifTrue: [ ^true ] ].
	^false! !

!Workspace methodsFor: 'binding' stamp: 'jmv 4/11/2010 21:45'!
initializeBindings
	
	bindings := Dictionary new! !

!Workspace methodsFor: 'menu commands' stamp: 'jmv 4/11/2010 21:51'!
addModelItemsToWindowMenu: aMenu
	"Add model-related items to the supplied window menu"

	aMenu addLine.
	aMenu
		add: 'save contents to file...'
		target: self
		action: #saveContentsInFile.
	aMenu
		add: 'append contents of file...'
		target: self
		action: #appendContentsOfFile.
	aMenu
		add: 'reset variables'
		target: self
		action: #initializeBindings.
	aMenu
		addUpdating: #mustDeclareVariableWording
		target: self
		action: #toggleVariableDeclarationMode.
	aMenu
		addUpdating: #toggleStylingLabel
		target: self
		action: #toggleStyling! !

!Workspace methodsFor: '*Shout-Styling' stamp: 'jmv 4/11/2010 21:53'!
shouldStyle

	^shouldStyle ifNil: [ Preferences shoutInWorkspaces]! !

!Workspace methodsFor: '*Shout-Styling' stamp: 'jmv 4/11/2010 21:56'!
shoutAboutToStyle: aSHTextStyler
	"This is a notification that aSHTextStyler is about to re-style its text."

	self shouldStyle ifFalse: [ ^false ].
	aSHTextStyler 
		classOrMetaClass: nil;
		workspace: self.
	^true! !

!Workspace methodsFor: '*Shout-Styling' stamp: 'jmv 4/11/2010 22:29'!
toggleStyling

	| codeTextMorph |
	shouldStyle _ self shouldStyle not.
	" Ugly hack, to restyle our contents. "
	codeTextMorph _ self codeTextMorph.
	codeTextMorph setText:
		codeTextMorph textMorph text asString asText! !

!Workspace methodsFor: '*Shout-Styling' stamp: 'jmv 4/11/2010 21:53'!
toggleStylingLabel

	^self shouldStyle 
		ifTrue: [ '<on> syntax highlighting' ]
		ifFalse: [ '<off> syntax highlighting' ]! !

!Workspace methodsFor: 'variable declarations' stamp: 'jmv 4/11/2010 21:47'!
mustDeclareVariableWording
	
	^ mustDeclareVariables not
		ifTrue: ['<yes> automatically create variable declaration' translated]
		ifFalse: ['<no> automatically create variable declaration' translated]! !

!Workspace methodsFor: 'variable declarations' stamp: 'jmv 4/11/2010 21:47'!
toggleVariableDeclarationMode

	mustDeclareVariables := mustDeclareVariables not! !

Workspace removeSelector: #aboutToStyle:!
!classDefinition: #Workspace category: #'Kernel-ST80 Remnants'!
StringHolder subclass: #Workspace
	instanceVariableNames: 'bindings mustDeclareVariables shouldStyle'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Kernel-ST80 Remnants'!

!Workspace reorganize!
('initialize-release' initialize)
('binding' bindingOf: hasBindingOf: hasBindingThatBeginsWith: initializeBindings)
('accessing' setBindings:)
('as yet unclassified' saveContentsInFile)
('drag and drop' acceptDroppingMorph:event:inMorph:)
('menu commands' addModelItemsToWindowMenu: appendContentsOfFile)
('code pane menu' editorClass)
('*Shout-Styling' shouldStyle shoutAboutToStyle: toggleStyling toggleStylingLabel)
('variable declarations' mustDeclareVariableWording toggleVariableDeclarationMode)
!

SHParserST80 removeSelector: #has:bindingThatBeginsWith:!
