SystemOrganization addCategory: #'OB-Shout-Core'!
SystemOrganization addCategory: #'OB-Shout-Morphs'!

OBMorphBuilder subclass: #OBShoutBuilder
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OB-Shout-Core'!

!OBShoutBuilder methodsFor: 'private' stamp: 'lr 2/26/2011 14:56'!
textMorphClass
	^ (Smalltalk classNamed: #SHTextStylerST80)
		ifNil: [ super textMorphClass ]
		ifNotNil: [ OBPluggableShoutTextMorph ]
		
! !

!OBClassDefinition methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 15:29'!
shouldBeStyledBy: aPluggableShoutMorph
	aPluggableShoutMorph classOrMetaClass: nil.
	^ true! !

!OBDefinitionPanel methodsFor: '*ob-shout' stamp: 'dc 8/24/2007 12:34'!
addItem: classAndMethod
	"Used by the system when the user clicks on a link in a class comment. For example see class comment of SystemProgressMorph and click on displayProgressAt:from:to:during:."
	|tokens class methodNode|
	tokens := classAndMethod findTokens: Character space.
	tokens size ~= 2 ifTrue: [^ self].
	class := Smalltalk classNamed: tokens first.
	class ifNil: [^ self].
	methodNode := OBMethodNode on: tokens second inClass: class.
	methodNode browse! !

!OBDefinitionPanel methodsFor: '*ob-shout' stamp: 'lr 2/26/2011 15:41'!
shoutAboutToStyle: aTextStyler
	^ self 
		withDefinitionDo: [ :def | def shouldBeStyledBy: aTextStyler ]
		ifNil: [ false ]! !

OBPluggableTextMorph subclass: #OBPluggableShoutTextMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OB-Shout-Morphs'!

!OBPluggableShoutTextMorph methodsFor: 'private' stamp: 'lr 2/26/2011 15:22'!
setText: aText
	(self model shoutAboutToStyle: styler)
		ifFalse: [ self setTextBasic: aText ]
		ifTrue: [
			self setTextBasic: (styler format: aText).
			aText size < 4096
				ifTrue: [ styler style: textMorph contents ]
				ifFalse: [ styler styleInBackgroundProcess: textMorph contents ] ]! !

!OBPluggableShoutTextMorph methodsFor: 'initialize' stamp: 'lr 2/26/2011 15:18'!
useDefaultStyler
	self styler: (SHTextStylerST80 new view: self)! !

OBMorphicPlatform subclass: #OBShoutPlatform
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OB-Shout-Core'!

!OBShoutPlatform class methodsFor: 'class initialization' stamp: 'cwp 8/26/2009 23:32'!
initialize
	OBPlatform current: self new! !

!OBShoutPlatform class methodsFor: 'class initialization' stamp: 'lr 8/21/2010 22:11'!
unload
	OBPlatform current: OBMorphicPlatform new! !

!OBShoutPlatform methodsFor: 'building' stamp: 'cwp 8/26/2009 22:18'!
builder
	^ OBShoutBuilder new! !

!OBNode methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 16:25'!
shouldBeStyledBy: aPluggableShoutMorph
	"Some nodes pretend to be a definition."

	^ false! !

!OBMethodDefinition methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 15:23'!
shouldBeStyledBy: aPluggableShoutMorph
	aPluggableShoutMorph classOrMetaClass: theClass.
	^ true! !

!OBDefinition methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 15:29'!
shouldBeStyledBy: aPluggableShoutMorph
	^ false! !
OBShoutPlatform initialize!