'From Squeak3.8alpha of ''17 July 2004'' [latest update: #5976] on 13 September 2004 at 10:42:22 am'! "Change Set: ExtensionsForShout-tween Date: 13 September 2004 Author: Andy Tween Adds a new AppRegistry subclass - MvcTextEditor. Sets the default for MvcTextEditor to be PluggableTextView. Modifies Browser etc. to use the MorphicTextEditor and MvcTextEditor default setting when creating the view/morph for editing code. These changes allow tools such as Shout to extend the base image functionality without overriding base image methods. Adds some new methods which are used by Shout, and could be useful in general. There should be no change to the behaviour of the system after installing this changeset - it is only refactoring and new methods"! AppRegistry subclass: #MvcTextEditor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Applications'! !MvcTextEditor commentStamp: 'tween 8/27/2004 12:24' prior: 0! A subclass of AppRegistry which allows the user, or Browser add-ons, to control which class is used when creating the code editing view in mvc Browsers! !CodeHolder methodsFor: 'construction' stamp: 'tween 8/27/2004 12:18'! buildMorphicCodePaneWith: editString "Construct the pane that shows the code. Respect the Preference for standardCodeFont." | codePane | codePane := MorphicTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. codePane font: Preferences standardCodeFont. editString ifNotNil: [codePane editString: editString. codePane hasUnacceptedEdits: true]. ^ codePane! ! !Browser methodsFor: 'initialize-release' stamp: 'tween 8/27/2004 12:01'! openEditString: aString "Create a pluggable version of all the views for a Browser, including views and controllers." | systemCategoryListView classListView messageCategoryListView messageListView browserCodeView topView switchView underPane y optionalButtonsView annotationPane | self couldOpenInMorphic ifTrue: [^ self openAsMorphEditing: aString]. "Sensor leftShiftDown ifTrue: [^ self openAsMorphEditing: aString]. uncomment-out for testing morphic browser embedded in mvc project" topView _ StandardSystemView new model: self. topView borderWidth: 1. "label and minSize taken care of by caller" systemCategoryListView _ PluggableListView on: self list: #systemCategoryList selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex: menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:. systemCategoryListView window: (0 @ 0 extent: 50 @ 70). topView addSubView: systemCategoryListView. classListView _ PluggableListView on: self list: #classList selected: #classListIndex changeSelected: #classListIndex: menu: #classListMenu:shifted: keystroke: #classListKey:from:. classListView window: (0 @ 0 extent: 50 @ 62). topView addSubView: classListView toRightOf: systemCategoryListView. switchView _ self buildInstanceClassSwitchView. switchView borderWidth: 1. topView addSubView: switchView below: classListView. messageCategoryListView _ PluggableListView on: self list: #messageCategoryList selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex: menu: #messageCategoryMenu:. messageCategoryListView controller terminateDuringSelect: true. messageCategoryListView window: (0 @ 0 extent: 50 @ 70). topView addSubView: messageCategoryListView toRightOf: classListView. messageListView _ PluggableListView on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:. messageListView window: (0 @ 0 extent: 50 @ 70). messageListView menuTitleSelector: #messageListSelectorTitle. topView addSubView: messageListView toRightOf: messageCategoryListView. self wantsAnnotationPane ifTrue: [annotationPane _ PluggableTextView on: self text: #annotation accept: nil readSelection: nil menu: nil. annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight). topView addSubView: annotationPane below: systemCategoryListView. underPane _ annotationPane. y _ 110 - self optionalAnnotationHeight] ifFalse: [ underPane _ systemCategoryListView. y _ 110]. self wantsOptionalButtons ifTrue: [optionalButtonsView _ self buildOptionalButtonsView. optionalButtonsView borderWidth: 1. topView addSubView: optionalButtonsView below: underPane. underPane _ optionalButtonsView. y _ y - self optionalButtonHeight]. browserCodeView _ MvcTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. browserCodeView window: (0@0 extent: 200@y). topView addSubView: browserCodeView below: underPane. aString ifNotNil: [browserCodeView editString: aString. browserCodeView hasUnacceptedEdits: true]. topView setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList). ^ topView! ! !Browser methodsFor: 'initialize-release' stamp: 'tween 8/27/2004 12:01'! openMessageCatEditString: aString "Create a pluggable version of the views for a Browser that just shows one message category." | messageCategoryListView messageListView browserCodeView topView annotationPane underPane y optionalButtonsView | self couldOpenInMorphic ifTrue: [^ self openAsMorphMsgCatEditing: aString]. topView _ (StandardSystemView new) model: self. topView borderWidth: 1. "label and minSize taken care of by caller" messageCategoryListView _ PluggableListView on: self list: #messageCatListSingleton selected: #indexIsOne changeSelected: #indexIsOne: menu: #messageCategoryMenu:. messageCategoryListView window: (0 @ 0 extent: 200 @ 12). topView addSubView: messageCategoryListView. messageListView _ PluggableListView on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:. messageListView menuTitleSelector: #messageListSelectorTitle. messageListView window: (0 @ 0 extent: 200 @ 70). topView addSubView: messageListView below: messageCategoryListView. self wantsAnnotationPane ifTrue: [annotationPane _ PluggableTextView on: self text: #annotation accept: nil readSelection: nil menu: nil. annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight). topView addSubView: annotationPane below: messageListView. underPane _ annotationPane. y _ (200 - 12 - 70) - self optionalAnnotationHeight] ifFalse: [underPane _ messageListView. y _ (200 - 12 - 70)]. self wantsOptionalButtons ifTrue: [optionalButtonsView _ self buildOptionalButtonsView. optionalButtonsView borderWidth: 1. topView addSubView: optionalButtonsView below: underPane. underPane _ optionalButtonsView. y _ y - self optionalButtonHeight]. browserCodeView _ MvcTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. browserCodeView window: (0@0 extent: 200@y). topView addSubView: browserCodeView below: underPane. aString ifNotNil: [browserCodeView editString: aString. browserCodeView hasUnacceptedEdits: true]. topView setUpdatablePanesFrom: #(messageCatListSingleton messageList). ^ topView! ! !Browser methodsFor: 'initialize-release' stamp: 'tween 8/27/2004 12:02'! openMessageEditString: aString "Create a pluggable version of the views for a Browser that just shows one message." | messageListView browserCodeView topView annotationPane underPane y | Smalltalk isMorphic ifTrue: [^ self openAsMorphMessageEditing: aString]. topView _ (StandardSystemView new) model: self. topView borderWidth: 1. "label and minSize taken care of by caller" messageListView _ PluggableListView on: self list: #messageListSingleton selected: #indexIsOne changeSelected: #indexIsOne: menu: #messageListMenu:shifted:. messageListView window: (0 @ 0 extent: 200 @ 12). topView addSubView: messageListView. self wantsAnnotationPane ifTrue: [annotationPane _ PluggableTextView on: self text: #annotation accept: nil readSelection: nil menu: nil. annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight). topView addSubView: annotationPane below: messageListView. underPane _ annotationPane. y _ (200 - 12) - self optionalAnnotationHeight] ifFalse: [underPane _ messageListView. y _ 200 - 12]. browserCodeView _ MvcTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. browserCodeView window: (0@0 extent: 200@y). topView addSubView: browserCodeView below: underPane. aString ifNotNil: [browserCodeView editString: aString. browserCodeView hasUnacceptedEdits: true]. ^ topView! ! !Browser methodsFor: 'initialize-release' stamp: 'tween 8/27/2004 12:02'! openOnClassWithEditString: aString "Create a pluggable version of all the views for a Browser, including views and controllers." | classListView messageCategoryListView messageListView browserCodeView topView switchView annotationPane underPane y optionalButtonsView | Smalltalk isMorphic ifTrue: [^ self openAsMorphClassEditing: aString]. topView _ (StandardSystemView new) model: self. topView borderWidth: 1. "label and minSize taken care of by caller" classListView _ PluggableListView on: self list: #classListSingleton selected: #indexIsOne changeSelected: #indexIsOne: menu: #classListMenu:shifted: keystroke: #classListKey:from:. classListView window: (0 @ 0 extent: 100 @ 12). topView addSubView: classListView. messageCategoryListView _ PluggableListView on: self list: #messageCategoryList selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex: menu: #messageCategoryMenu:. messageCategoryListView window: (0 @ 0 extent: 100 @ 70). topView addSubView: messageCategoryListView below: classListView. messageListView _ PluggableListView on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:. messageListView menuTitleSelector: #messageListSelectorTitle. messageListView window: (0 @ 0 extent: 100 @ 70). topView addSubView: messageListView toRightOf: messageCategoryListView. switchView _ self buildInstanceClassSwitchView. switchView borderWidth: 1. switchView window: switchView window viewport: (classListView viewport topRight corner: messageListView viewport topRight). topView addSubView: switchView toRightOf: classListView. self wantsAnnotationPane ifTrue: [annotationPane _ PluggableTextView on: self text: #annotation accept: nil readSelection: nil menu: nil. annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight). topView addSubView: annotationPane below: messageCategoryListView. underPane _ annotationPane. y _ (200-12-70) - self optionalAnnotationHeight] ifFalse: [underPane _ messageCategoryListView. y _ (200-12-70)]. self wantsOptionalButtons ifTrue: [optionalButtonsView _ self buildOptionalButtonsView. optionalButtonsView borderWidth: 1. topView addSubView: optionalButtonsView below: underPane. underPane _ optionalButtonsView. y _ y - self optionalButtonHeight]. browserCodeView _ MvcTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. browserCodeView window: (0@0 extent: 200@y). topView addSubView: browserCodeView below: underPane. aString ifNotNil: [browserCodeView editString: aString. browserCodeView hasUnacceptedEdits: true]. topView setUpdatablePanesFrom: #(messageCategoryList messageList). ^ topView! ! !Browser methodsFor: 'initialize-release' stamp: 'tween 8/27/2004 12:02'! openSystemCatEditString: aString "Create a pluggable version of all the views for a Browser, including views and controllers. The top list view is of the currently selected system class category--a single item list." | systemCategoryListView classListView messageCategoryListView messageListView browserCodeView topView switchView y annotationPane underPane optionalButtonsView | Smalltalk isMorphic ifTrue: [^ self openAsMorphSysCatEditing: aString]. topView _ (StandardSystemView new) model: self. topView borderWidth: 1. "label and minSize taken care of by caller" systemCategoryListView _ PluggableListView on: self list: #systemCategorySingleton selected: #indexIsOne changeSelected: #indexIsOne: menu: #systemCatSingletonMenu: keystroke: #systemCatSingletonKey:from:. systemCategoryListView window: (0 @ 0 extent: 200 @ 12). topView addSubView: systemCategoryListView. classListView _ PluggableListView on: self list: #classList selected: #classListIndex changeSelected: #classListIndex: menu: #classListMenu:shifted: keystroke: #classListKey:from:. classListView window: (0 @ 0 extent: 67 @ 62). topView addSubView: classListView below: systemCategoryListView. messageCategoryListView _ PluggableListView on: self list: #messageCategoryList selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex: menu: #messageCategoryMenu:. messageCategoryListView controller terminateDuringSelect: true. messageCategoryListView window: (0 @ 0 extent: 66 @ 70). topView addSubView: messageCategoryListView toRightOf: classListView. switchView _ self buildInstanceClassSwitchView. switchView window: switchView window viewport: (classListView viewport bottomLeft corner: messageCategoryListView viewport bottomLeft). switchView borderWidth: 1. topView addSubView: switchView below: classListView. messageListView _ PluggableListView on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:. messageListView menuTitleSelector: #messageListSelectorTitle. messageListView window: (0 @ 0 extent: 67 @ 70). topView addSubView: messageListView toRightOf: messageCategoryListView. self wantsAnnotationPane ifTrue: [annotationPane _ PluggableTextView on: self text: #annotation accept: nil readSelection: nil menu: nil. annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight). topView addSubView: annotationPane below: switchView. y _ 110 - 12 - self optionalAnnotationHeight. underPane _ annotationPane] ifFalse: [y _ 110 - 12. underPane _ switchView]. self wantsOptionalButtons ifTrue: [optionalButtonsView _ self buildOptionalButtonsView. optionalButtonsView borderWidth: 1. topView addSubView: optionalButtonsView below: underPane. underPane _ optionalButtonsView. y _ y - self optionalButtonHeight]. browserCodeView _ MvcTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. browserCodeView window: (0@0 extent: 200@y). topView addSubView: browserCodeView below: underPane. aString ifNotNil: [browserCodeView editString: aString. browserCodeView hasUnacceptedEdits: true]. topView setUpdatablePanesFrom: #(classList messageCategoryList messageList). ^ topView! ! !Dictionary methodsFor: 'testing' stamp: 'tween 9/13/2004 10:11'! 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! ! !FileContentsBrowser methodsFor: 'creation' stamp: 'tween 8/27/2004 12:05'! addLowerPanesTo: window at: nominalFractions with: editString | verticalOffset row codePane infoPane infoHeight divider | row _ AlignmentMorph newColumn hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 1; borderColor: Color black; layoutPolicy: ProportionalLayout new. codePane _ MorphicTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. infoPane _ PluggableTextMorph on: self text: #infoViewContents accept: nil readSelection: nil menu: nil. infoPane askBeforeDiscardingEdits: false. verticalOffset _ 0. ">>not with this browser--- at least not yet --- innerFractions _ 0@0 corner: 1@0. verticalOffset _ self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset. verticalOffset _ self addOptionalButtonsTo: row at: innerFractions plus: verticalOffset. <<<<" infoHeight _ 20. row addMorph: (codePane borderWidth: 0) fullFrame: ( LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@verticalOffset corner: 0@infoHeight negated) ). divider _ BorderedSubpaneDividerMorph forTopEdge. Preferences alternativeWindowLook ifTrue:[ divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2. ]. row addMorph: divider fullFrame: ( LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@infoHeight negated corner: 0@(1-infoHeight)) ). row addMorph: (infoPane borderWidth: 0; hideScrollBarsIndefinitely) fullFrame: ( LayoutFrame fractions: (0@1 corner: 1@1) offsets: (0@(1-infoHeight) corner: 0@0) ). window addMorph: row frame: nominalFractions. row on: #mouseEnter send: #paneTransition: to: window. row on: #mouseLeave send: #paneTransition: to: window. ! ! !FileContentsBrowser methodsFor: 'creation' stamp: 'tween 8/27/2004 12:06'! createViews "Create a pluggable version of all the views for a Browser, including views and controllers." | hasSingleFile width topView packageListView classListView switchView messageCategoryListView messageListView browserCodeView infoView | contentsSymbol _ self defaultDiffsSymbol. "#showDiffs or #prettyDiffs" Smalltalk isMorphic ifTrue: [^ self openAsMorph]. (hasSingleFile _ self packages size = 1) ifTrue: [width _ 150] ifFalse: [width _ 200]. (topView _ StandardSystemView new) model: self; borderWidth: 1. "label and minSize taken care of by caller" hasSingleFile ifTrue: [ self systemCategoryListIndex: 1. packageListView _ PluggableListView on: self list: #systemCategorySingleton selected: #indexIsOne changeSelected: #indexIsOne: menu: #packageListMenu: keystroke: #packageListKey:from:. packageListView window: (0 @ 0 extent: width @ 12)] ifFalse: [ packageListView _ PluggableListView on: self list: #systemCategoryList selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex: menu: #packageListMenu: keystroke: #packageListKey:from:. packageListView window: (0 @ 0 extent: 50 @ 70)]. topView addSubView: packageListView. classListView _ PluggableListView on: self list: #classList selected: #classListIndex changeSelected: #classListIndex: menu: #classListMenu: keystroke: #classListKey:from:. classListView window: (0 @ 0 extent: 50 @ 62). hasSingleFile ifTrue: [topView addSubView: classListView below: packageListView] ifFalse: [topView addSubView: classListView toRightOf: packageListView]. switchView _ self buildInstanceClassSwitchView. switchView borderWidth: 1. topView addSubView: switchView below: classListView. messageCategoryListView _ PluggableListView on: self list: #messageCategoryList selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex: menu: #messageCategoryMenu:. messageCategoryListView window: (0 @ 0 extent: 50 @ 70). topView addSubView: messageCategoryListView toRightOf: classListView. messageListView _ PluggableListView on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu: keystroke: #messageListKey:from:. messageListView window: (0 @ 0 extent: 50 @ 70). topView addSubView: messageListView toRightOf: messageCategoryListView. browserCodeView _ MvcTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. browserCodeView window: (0@0 extent: width@110). topView addSubView: browserCodeView below: (hasSingleFile ifTrue: [switchView] ifFalse: [packageListView]). infoView _ StringHolderView new model: self infoString; window: (0@0 extent: width@12); borderWidth: 1. topView addSubView: infoView below: browserCodeView. ^ topView ! ! !PackagePaneBrowser methodsFor: 'package list' stamp: 'tween 8/27/2004 12:08'! openEditString: aString "Create a pluggable version of all the views for a Browser, including views and controllers." "PackageBrowser openBrowser" | packageListView systemCategoryListView classListView messageCategoryListView messageListView browserCodeView topView switchView annotationPane underPane y optionalButtonsView | self couldOpenInMorphic ifTrue: [^ self openAsMorphEditing: aString]. topView := StandardSystemView new model: self. topView borderWidth: 1. "label and minSize taken care of by caller" packageListView := PluggableListView on: self list: #packageList selected: #packageListIndex changeSelected: #packageListIndex: menu: #packageMenu:. packageListView window: (0 @ 0 extent: 20 @ 70). topView addSubView: packageListView. systemCategoryListView := PluggableListView on: self list: #systemCategoryList selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex: menu: #systemCategoryMenu:. systemCategoryListView window: (20 @ 0 extent: 30 @ 70). topView addSubView: systemCategoryListView. classListView := PluggableListView on: self list: #classList selected: #classListIndex changeSelected: #classListIndex: menu: #classListMenu:shifted:. classListView window: (0 @ 0 extent: 50 @ 62). topView addSubView: classListView toRightOf: systemCategoryListView. switchView := self buildInstanceClassSwitchView. switchView borderWidth: 1. topView addSubView: switchView below: classListView. messageCategoryListView := PluggableListView on: self list: #messageCategoryList selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex: menu: #messageCategoryMenu:. messageCategoryListView window: (0 @ 0 extent: 50 @ 70). topView addSubView: messageCategoryListView toRightOf: classListView. messageListView := PluggableListView on: self list: #messageList selected: #messageListIndex changeSelected: #messageListIndex: menu: #messageListMenu:shifted: keystroke: #messageListKey:from:. messageListView window: (0 @ 0 extent: 50 @ 70). topView addSubView: messageListView toRightOf: messageCategoryListView. self wantsAnnotationPane ifTrue: [annotationPane _ PluggableTextView on: self text: #annotation accept: nil readSelection: nil menu: nil. annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight). topView addSubView: annotationPane below: packageListView. underPane _ annotationPane. y _ 110 - self optionalAnnotationHeight] ifFalse: [underPane _ packageListView. y _ 110]. self wantsOptionalButtons ifTrue: [optionalButtonsView _ self buildOptionalButtonsView. optionalButtonsView borderWidth: 1. topView addSubView: optionalButtonsView below: underPane. underPane _ optionalButtonsView. y _ y - self optionalButtonHeight]. browserCodeView := MvcTextEditor default on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. browserCodeView window: (0@0 extent: 200@y). topView addSubView: browserCodeView below: underPane. aString ifNotNil: [browserCodeView editString: aString. browserCodeView hasUnacceptedEdits: true]. ^ topView! ! !PluggableTextMorph methodsFor: 'menu commands' stamp: 'tween 8/29/2004 20:28'! accept "Inform the model of text to be accepted, and return true if OK." | ok saveSelection saveScrollerOffset | "sps 8/13/2001 22:41: save selection and scroll info" saveSelection _ self selectionInterval copy. saveScrollerOffset _ scroller offset copy. (self canDiscardEdits and: [(self hasProperty: #alwaysAccept) not]) ifTrue: [^ self flash]. self hasEditingConflicts ifTrue: [(self confirm: 'Caution!! This method may have been changed elsewhere since you started editing it here. Accept anyway?' translated) ifFalse: [^ self flash]]. ok _ self acceptTextInModel. ok==true ifTrue: [self setText: self getText. self hasUnacceptedEdits: false. (model dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]] ifNone: [nil]) ifNotNilDo: [:aPane | model changed: #annotation]]. "sps 8/13/2001 22:41: restore selection and scroll info" ["During the step for the browser, updateCodePaneIfNeeded is called, and invariably resets the contents of the codeholding PluggableTextMorph at that time, resetting the cursor position and scroller in the process. The following line forces that update without waiting for the step, then restores the cursor and scrollbar" ok ifTrue: "(don't bother if there was an error during compile)" [(model isKindOf: CodeHolder) ifTrue: [model updateCodePaneIfNeeded]. WorldState addDeferredUIMessage: [self currentHand newKeyboardFocus: textMorph. scroller offset: saveScrollerOffset. self setScrollDeltas. self selectFrom: saveSelection first to: saveSelection last]]] on: Error do: [] ! ! !PluggableTextMorph methodsFor: 'menu commands' stamp: 'tween 8/29/2004 20:25'! acceptTextInModel "Inform the model that the receiver's textMorph's text should be accepted. Answer true if the model accepted ok, false otherwise" | textToAccept | textToAccept := textMorph asText. ^setTextSelector isNil or: [setTextSelector numArgs = 2 ifTrue: [model perform: setTextSelector with: textToAccept with: self] ifFalse: [model perform: setTextSelector with: textToAccept]] ! ! !PluggableTextMorph methodsFor: 'model access' stamp: 'tween 8/29/2004 20:43'! setText: 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.! ! !PluggableTextMorph methodsFor: 'private' stamp: 'tween 8/29/2004 20:42'! textMorphClass "Answer the class used to create the receiver's textMorph" ^TextMorphForEditView! ! !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! ! !Symbol class methodsFor: 'access' stamp: 'tween 9/13/2004 10:09'! thatStartsCaseSensitive: leadingCharacters skipping: skipSym "Same as thatStarts:skipping: but caseSensitive" | size firstMatch key | size := leadingCharacters size. size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]]. firstMatch := leadingCharacters at: 1. size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size]. self allSymbolTablesDo: [:each | each size >= size ifTrue: [ ((each at: 1) == firstMatch and: [key == nil or: [(each findString: key startingAt: 2 caseSensitive: true) = 2]]) ifTrue: [^each] ] ] after: skipSym. ^nil ! ! !Text methodsFor: 'accessing' stamp: 'tween 9/13/2004 10:07'! runs: anArray runs := anArray! ! !TextMorph methodsFor: 'private' stamp: 'tween 8/29/2004 20:33'! editorClass "Answer the class used to create the receiver's editor" ^TextMorphEditor! ! !TextMorph methodsFor: 'private' stamp: 'tween 8/29/2004 20:34'! 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! ! !Symbol class reorganize! ('access' findInterned: selectorsContaining: thatStarts:skipping: thatStartsCaseSensitive:skipping:) ('class initialization' allSymbolTablesDo: allSymbolTablesDo:after: compactSymbolTable compareTiming initialize) ('instance creation' intern: internCharacter: lookup: newFrom: readFrom:) ('private' hasInterned:ifTrue: possibleSelectorsFor: rehash shutDown:) ('*Shout-Parsing') ! !SharedPool class reorganize! ('name lookup' bindingOf: bindingsDo: classBindingOf: hasBindingThatBeginsWith: includesKey:) ('*Shout-Parsing') ! !PluggableTextMorph reorganize! ('accessing' getTextSelector) ('debug and other' installModelIn:) ('dependents access' canDiscardEdits hasUnacceptedEdits) ('drawing' drawOn: wantsFrameAdornments) ('dropping/grabbing' wantsDroppedMorph:event:) ('editor access' handleEdit: scrollSelectionIntoView scrollSelectionIntoView: selectAll setTextMorphToSelectAllOnMouseEnter) ('event handling' handlesKeyboard: keyStroke: mouseEnter: mouseLeave:) ('geometry' extent: extraScrollRange resetExtent scrollDeltaHeight) ('initialization' acceptOnCR: editString: font: initialize on:text:accept:readSelection:menu:) ('interactive error protocol' correctFrom:to:with: correctSelectionWithString: deselect nextTokenFrom:direction: notify:at:in: select selectFrom:to: selectInvisiblyFrom:to: selectionInterval) ('layout' acceptDroppingMorph:event:) ('menu commands' accept acceptTextInModel again browseChangeSetsWithSelector browseIt cancel changeStyle chooseAlignment classCommentsContainingIt classNamesContainingIt copySelection cut debugIt doIt explain exploreIt fileItIn find findAgain implementorsOfIt inspectIt languagePrefs methodNamesContainingIt methodSourceContainingIt methodStringsContainingit offerFontMenu paste pasteRecent presentSpecialMenu prettyPrint prettyPrintWithColor printIt printerSetup recognizeCharacters referencesToIt saveContentsInFile selectionAsTiles sendContentsToPrinter sendersOfIt setSearchString spawn tileForIt toggleAnnotationPaneSize translateIt undo verifyWordSpelling wordDefinition yellowButtonActivity) ('model access' eToyGetMainFont getSelection getText selectionInterval: setSelection: setText: setTextColor: text) ('scroll bar events' scrollBarMenuButtonPressed: yellowButtonActivity:) ('transcript' appendEntry appendTextEtoy: bsText changeText: replaceSelectionWith:) ('unaccepted edits' askBeforeDiscardingEdits: hasEditingConflicts hasEditingConflicts: hasUnacceptedEdits: promptForCancel) ('updating' update:) ('scrolling' hUnadjustedScrollRange) ('*network-irc-gui') ('private' textMorphClass) ! !Dictionary reorganize! ('accessing' associationAt: associationAt:ifAbsent: associationDeclareAt: associations at: at:ifAbsent: at:ifAbsentPut: at:ifPresent: at:ifPresentAndInMemory: at:put: keyAtIdentityValue: keyAtIdentityValue:ifAbsent: keyAtValue: keyAtValue:ifAbsent: keys keysSortedSafely values) ('testing' hasBindingThatBeginsWith: hasContentsInExplorer includes: includesIdentity: includesKey: keyForIdentity: occurrencesOf:) ('adding' add: addAll: declare:from:) ('removing' keysAndValuesRemove: remove: remove:ifAbsent: removeKey: removeKey:ifAbsent: removeUnreferencedKeys unreferencedKeys) ('enumerating' associationsDo: collect: do: keysAndValuesDo: keysDo: select: valuesDo:) ('printing' flattenOnStream: printElementsOn: storeOn:) ('private' copy errorKeyNotFound errorValueNotFound keyAt: noCheckAdd: rehash scanFor: valueAtNewKey:put:atIndex:declareFrom:) ('user interface' explorerContents inspect inspectWithLabel:) ('*Compiler' bindingOf: bindingsDo:) ('comparing' =) ('*Shout-Parsing') ! "Postscript: Adds a new AppRegistry subclass - MvcTextEditor. Sets the default for MvcTextEditor to be PluggableTextView. Modifies Browser etc. to use the MorphicTextEditor and MvcTextEditor default setting when creating the view/morph for editing code. These changes allow tools such as Shout to extend the base image functionality without overriding base image methods. Adds some new methods which are used by Shout, and could be useful in general. There should be no change to the behaviour of the system after installing this changeset - it is only refactoring and new methods" MvcTextEditor register: PluggableTextView. !