SystemOrganization addCategory: #ShoutOmniBrowser! !OBDefinitionPanel methodsFor: '*ShoutOmniBrowser-addition' stamp: 'tween 7/9/2006 10:26'! shoutAboutToStyle: aPluggableShoutMorph | node classOrMetaClass | node := browser currentNode. ((node isKindOf: OBMethodNode) or: [(node isKindOf: OBMethodVersionNode) or:[node isKindOf: OBMethodCategoryNode]]) ifTrue:[ classOrMetaClass := node theClass. (classOrMetaClass isBehavior or:[classOrMetaClass isTrait]) ifFalse:[classOrMetaClass := nil]. aPluggableShoutMorph classOrMetaClass: classOrMetaClass. ^true]. ((node isKindOf: OBClassNode) or:[(node isKindOf: OBClassCategoryNode)]) ifTrue:[ aPluggableShoutMorph classOrMetaClass: nil. ^true]. ^false! ! OBTextMorphEditor subclass: #OBTextMorphEditorWithShout instanceVariableNames: 'inBackTo' classVariableNames: '' poolDictionaries: '' category: 'ShoutOmniBrowser'! !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: 'tween 3/15/2007 14:17'! blinkParen lastParentLocation ifNotNil: [self text string size >= lastParentLocation ifTrue: [ self text addAttribute: TextEmphasis bold from: lastParentLocation to: lastParentLocation]] ! ! !OBTextMorphEditorWithShout methodsFor: 'new selection' stamp: 'tween 3/15/2007 14:18'! changeEmphasis: characterStream morph editView styler evaluateWithoutStyling: [^super changeEmphasis: characterStream]! ! !OBTextMorphEditorWithShout methodsFor: 'parenblinking' stamp: 'tween 3/15/2007 14:18'! clearParens super clearParens. lastParentLocation := nil ! ! !OBTextMorphEditorWithShout methodsFor: 'new selection' stamp: 'tween 3/15/2007 14:19'! correctFrom: start to: stop with: aString view ifNotNil: [view correctFrom: start to: stop with: aString]. ^super correctFrom: start to: stop with: aString! ! !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] ! ! OBPluggableTextMorph subclass: #OBPluggableTextMorphWithShout instanceVariableNames: 'styler unstyledAcceptText' classVariableNames: '' poolDictionaries: '' category: 'ShoutOmniBrowser'! !OBPluggableTextMorphWithShout class methodsFor: 'instance creation' stamp: 'tween 3/15/2007 13:58'! on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel |styler answer | answer := self new. styler := SHTextStylerST80 new view: answer; yourself. "styler when: #aboutToStyle send: #shoutStylerAboutToStyle: to: anObject with: styler." ^ 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: 'tween 3/15/2007 14:00'! correctFrom: start to: stop with: aString "see the comment in #acceptTextInModel " unstyledAcceptText ifNotNil:[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: 'tween 3/15/2007 14:00'! font: aFont super font: aFont. styler ifNotNil: [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: 'tween 3/15/2007 14:01'! okToStyle styler ifNil:[^false]. Preferences syntaxHighlightingAsYouType ifFalse: [^false]. (model respondsTo: #shoutAboutToStyle: ) ifFalse:[^true]. ^model shoutAboutToStyle: self ! ! !OBPluggableTextMorphWithShout methodsFor: 'private' stamp: 'tween 3/15/2007 14:14'! privateSetText: aText scrollBar setValue: 0.0. textMorph ifNil: [textMorph _ self textMorphClass new contents: aText wrappedTo: self innerBounds width-6. textMorph setEditView: self. scroller addMorph: textMorph] ifNotNil: [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: 'tween 3/15/2007 14:02'! stylerStyled: styledCopyOfText textMorph contents runs: styledCopyOfText runs . textMorph paragraph recomposeFrom: 1 to: textMorph contents size delta: 0. textMorph updateFromParagraph. selectionInterval ifNotNil:[ 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 methodsFor: '*ShoutOmniBrowser-override' stamp: 'dc 4/21/2007 16:42'! definitionPanel: aDefinitionPanel with: aBlock "see CodeHolder>>buildMorphicCodePaneWith:" | morph | morph _ OBPluggableTextMorphWithShout on: aDefinitionPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:. morph font: Preferences standardCodeFont; borderWidth: 0; vResizing: #spaceFill; hResizing: #spaceFill. current ifNotNil: [current addMorphBack: morph]. ^ self current: morph do: aBlock! ! OBTextMorph subclass: #OBTextMorphWithShout instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ShoutOmniBrowser'! !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: 'tween 3/15/2007 14:25'! 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 ifNotNil: [stateArray _ priorEditor stateArray]. editor _ self editorClass new morph: self. editor changeParagraph: self paragraph. priorEditor ifNotNil: [editor stateArrayPut: stateArray]. self selectionChanged. ^ editor! !