SystemOrganization addCategory: #'OB-Shout-Core'! SystemOrganization addCategory: #'OB-Shout-Morphs'! !OBNode methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 16:25'! shouldBeStyledBy: aPluggableShoutMorph "Some nodes pretend to be a definition." ^ false! ! OBPluggableTextMorph subclass: #OBPluggableTextMorphWithShout instanceVariableNames: 'styler unstyledAcceptText' classVariableNames: '' poolDictionaries: '' category: 'OB-Shout-Morphs'! !OBPluggableTextMorphWithShout class methodsFor: 'instance creation' stamp: 'lr 3/4/2009 08:17'! on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel | styler answer stylerClass | answer := self new. stylerClass := Smalltalk classNamed: #SHTextStylerST80. styler := stylerClass isNil ifFalse: [ stylerClass new view: answer; yourself ]. ^ answer styler: styler; on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel! ! !OBPluggableTextMorphWithShout methodsFor: 'accepting' stamp: 'tween 3/15/2007 14:00'! acceptTextInModel self okToStyle ifFalse:[^super acceptTextInModel]. "#correctFrom:to:with: is sent when the method source is manipulated during compilation (removing unused temps, changing selectors etc). But #correctFrom:to:with: operates on the textMorph's text, and we may be saving an unstyled copy of the text. This means that these corrections will be lost unless we also apply the corrections to the unstyled copy that we are saving. So remember the unstyled copy in unstyledAcceptText, so that when #correctFrom:to:with: is received we can also apply the correction to it" unstyledAcceptText := styler unstyledTextFrom: textMorph asText. [^setTextSelector isNil or: [setTextSelector numArgs = 2 ifTrue: [model perform: setTextSelector with: unstyledAcceptText with: self] ifFalse: [model perform: setTextSelector with: unstyledAcceptText]] ] ensure:[unstyledAcceptText := nil]! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:00'! classOrMetaClass: aBehavior "set the classOrMetaClass in the receiver's styler to aBehavior" styler classOrMetaClass: aBehavior ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'lr 3/4/2009 08:17'! correctFrom: start to: stop with: aString "see the comment in #acceptTextInModel " unstyledAcceptText isNil ifFalse: [ unstyledAcceptText replaceFrom: start to: stop with: aString ]. ^ super correctFrom: start to: stop with: aString! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:00'! environment: anObject "set the environment in the receiver's styler to anObject" styler environment: anObject ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'lr 3/4/2009 08:17'! font: aFont super font: aFont. styler isNil ifFalse: [ styler font: aFont ]! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:01'! hasUnacceptedEdits: aBoolean "re-implemented to re-style the text iff aBoolean is true" super hasUnacceptedEdits: aBoolean. (aBoolean and: [self okToStyle]) ifTrue: [ styler styleInBackgroundProcess: textMorph contents]! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'lr 3/4/2009 22:13'! okToStyle styler ifNil:[^false]. Preferences syntaxHighlightingAsYouType ifFalse: [^false]. (model respondsTo: #shoutAboutToStyle: ) ifFalse:[^true]. ^model shoutAboutToStyle: self ! ! !OBPluggableTextMorphWithShout methodsFor: 'private' stamp: 'lr 3/4/2009 08:20'! privateSetText: aText scrollBar setValue: 0.0. textMorph isNil ifTrue: [ textMorph := self textMorphClass new contents: aText wrappedTo: self innerBounds width - 6. textMorph setEditView: self. scroller addMorph: textMorph ] ifFalse: [ textMorph newContents: aText ]. self hasUnacceptedEdits: false. self setScrollDeltas! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:14'! setText: aText self okToStyle ifFalse:[^self privateSetText: aText]. self privateSetText: (styler format: aText asText). aText size < 4096 ifTrue:[ styler style: textMorph contents] ifFalse:[styler styleInBackgroundProcess: textMorph contents] ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:01'! sourceMap: aSortedCollection "set the sourceMap in the receiver's styler to aSortedCollection" styler sourceMap: aSortedCollection ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:01'! styler ^styler ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:02'! styler: anObject styler := anObject ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'lr 3/4/2009 08:17'! stylerStyled: styledCopyOfText textMorph contents runs: styledCopyOfText runs. "textMorph paragraph recomposeFrom: 1 to: textMorph contents size delta: 0." "caused chars to appear in wrong order esp. in demo mode. remove this line when sure it is fixed" textMorph updateFromParagraph. selectionInterval isNil ifFalse: [ textMorph editor selectInvisiblyFrom: selectionInterval first to: selectionInterval last; storeSelectionInParagraph; setEmphasisHere ]. textMorph editor blinkParen. self scrollSelectionIntoView! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:02'! stylerStyledInBackground: styledCopyOfText "It is possible that the text string has changed since the styling began. Disregard the styles if styledCopyOfText's string differs with the current textMorph contents string" textMorph contents string = styledCopyOfText string ifTrue: [self stylerStyled: styledCopyOfText] ! ! !OBPluggableTextMorphWithShout methodsFor: 'private' stamp: 'tween 3/15/2007 14:15'! textMorphClass "Answer the class used to create the receiver's textMorph" ^OBTextMorphWithShout! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:02'! workspace: anObject "set the workspace in the receiver's styler to anObject" styler workspace: anObject ! ! OBMorphBuilder subclass: #OBShoutBuilder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Shout-Core'! !OBShoutBuilder methodsFor: 'private' stamp: 'cwp 8/27/2009 22:00'! textMorphClass ^ (Smalltalk classNamed: #SHTextStylerST80) ifNil: [ OBPluggableTextMorph ] ifNotNil: [ OBPluggableTextMorphWithShout ] ! ! OBTextMorph subclass: #OBTextMorphWithShout instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Shout-Morphs'! !OBTextMorphWithShout methodsFor: 'private' stamp: 'tween 3/15/2007 14:08'! editorClass "Answer the class used to create the receiver's editor" ^OBTextMorphEditorWithShout! ! !OBTextMorphWithShout methodsFor: 'private' stamp: 'lr 3/4/2009 08:17'! installEditorToReplace: priorEditor "Install an editor for my paragraph. This constitutes 'hasFocus'. If priorEditor is not nil, then initialize the new editor from its state. We may want to rework this so it actually uses the prior editor." | stateArray | priorEditor isNil ifFalse: [ stateArray := priorEditor stateArray ]. editor := self editorClass new morph: self. editor changeParagraph: self paragraph. priorEditor isNil ifFalse: [ editor stateArrayPut: stateArray ]. self selectionChanged. ^ editor! ! !OBDefinition methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 15:29'! shouldBeStyledBy: aPluggableShoutMorph ^ false! ! OBTextMorphEditor subclass: #OBTextMorphEditorWithShout instanceVariableNames: 'inBackTo' classVariableNames: '' poolDictionaries: '' category: 'OB-Shout-Morphs'! !OBTextMorphEditorWithShout methodsFor: 'backspace handling' stamp: 'tween 3/15/2007 14:16'! backTo: startIndex "When backspacing, 2 notifications of the userHasEdited are received. This then causes a background process to not terminate correctly. The reason for all this is uncertain, but discarding the superfluous userHasEdited message received while running backTo: seems to cure the problem" | answer | [inBackTo := true. answer := super backTo: startIndex ] ensure:[ inBackTo:=false. ^answer] ! ! !OBTextMorphEditorWithShout methodsFor: 'parenblinking' stamp: 'lr 3/4/2009 08:17'! blinkParen lastParentLocation isNil ifFalse: [ self text string size >= lastParentLocation ifTrue: [ self text addAttribute: TextEmphasis bold from: lastParentLocation to: lastParentLocation ] ]! ! !OBTextMorphEditorWithShout methodsFor: 'parenblinking' stamp: 'tween 3/15/2007 14:18'! clearParens super clearParens. lastParentLocation := nil ! ! !OBTextMorphEditorWithShout methodsFor: 'backspace handling' stamp: 'tween 3/15/2007 14:16'! userHasEdited "ignore this if generated during backTo: See comment in backTo: " (inBackTo isNil or: [inBackTo not]) ifTrue:[^super userHasEdited] ! ! !OBMethodDefinition methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 15:23'! shouldBeStyledBy: aPluggableShoutMorph aPluggableShoutMorph classOrMetaClass: theClass. ^ true! ! !OBClassDefinition methodsFor: '*ob-shout' stamp: 'lr 1/28/2010 15:29'! shouldBeStyledBy: aPluggableShoutMorph aPluggableShoutMorph classOrMetaClass: nil. ^ true! ! 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 6/5/2010 18:24'! unload OBPlatform current: OBMorphicPlatform! ! !OBShoutPlatform methodsFor: 'building' stamp: 'cwp 8/26/2009 22:18'! builder ^ OBShoutBuilder new! ! !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 1/28/2010 15:22'! shoutAboutToStyle: aPluggableShoutMorph ^ self withDefinitionDo: [ :def | def shouldBeStyledBy: aPluggableShoutMorph ] ifNil: [ false ]! ! OBShoutPlatform initialize!